equal
deleted
inserted
replaced
|
1 {- |
|
2 * Hedgewars, a free turn based strategy game |
|
3 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com> |
|
4 * |
|
5 * This program is free software; you can redistribute it and/or modify |
|
6 * it under the terms of the GNU General Public License as published by |
|
7 * the Free Software Foundation; version 2 of the License |
|
8 * |
|
9 * This program is distributed in the hope that it will be useful, |
|
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
12 * GNU General Public License for more details. |
|
13 * |
|
14 * You should have received a copy of the GNU General Public License |
|
15 * along with this program; if not, write to the Free Software |
|
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
|
17 \-} |
|
18 |
1 {-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-} |
19 {-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-} |
2 module OfficialServer.DBInteraction |
20 module OfficialServer.DBInteraction |
3 ( |
21 ( |
4 startDBConnection |
22 startDBConnection |
5 ) where |
23 ) where |
47 case q of |
65 case q of |
48 CheckAccount clId clUid _ clHost -> |
66 CheckAccount clId clUid _ clHost -> |
49 writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest) |
67 writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest) |
50 ClearCache -> return () |
68 ClearCache -> return () |
51 SendStats {} -> return () |
69 SendStats {} -> return () |
|
70 GetReplayName {} -> return () |
|
71 StoreAchievements {} -> return () |
52 flushRequests si |
72 flushRequests si |
53 |
73 |
54 pipeDbConnectionLoop :: Chan DBQuery -> Chan CoreMessage -> Handle -> Handle -> Map.Map ByteString (UTCTime, AccountInfo) -> Int -> IO (Map.Map ByteString (UTCTime, AccountInfo), Int) |
74 pipeDbConnectionLoop :: Chan DBQuery -> Chan CoreMessage -> Handle -> Handle -> Map.Map ByteString (UTCTime, AccountInfo) -> Int -> IO (Map.Map ByteString (UTCTime, AccountInfo), Int) |
55 pipeDbConnectionLoop queries cChan hIn hOut accountsCache req = |
75 pipeDbConnectionLoop queries cChan hIn hOut accountsCache req = |
56 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, req)) $ |
76 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, req)) $ |
75 else |
95 else |
76 do |
96 do |
77 writeChan cChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry) |
97 writeChan cChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry) |
78 return (accountsCache, req) |
98 return (accountsCache, req) |
79 |
99 |
|
100 GetReplayName {} -> do |
|
101 SIO.hPutStrLn hIn $ show q |
|
102 hFlush hIn |
|
103 |
|
104 (clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead) |
|
105 |
|
106 writeChan cChan $ ClientAccountInfo clId' clUid' accountInfo |
|
107 return (accountsCache, req) |
|
108 |
80 ClearCache -> return (Map.empty, req) |
109 ClearCache -> return (Map.empty, req) |
|
110 StoreAchievements {} -> ( |
|
111 (SIO.hPutStrLn hIn $ show q) >> |
|
112 hFlush hIn >> |
|
113 return (accountsCache, req)) |
|
114 `Exception.onException` |
|
115 (unGetChan queries q) |
81 SendStats {} -> ( |
116 SendStats {} -> ( |
82 (SIO.hPutStrLn hIn $ show q) >> |
117 (SIO.hPutStrLn hIn $ show q) >> |
83 hFlush hIn >> |
118 hFlush hIn >> |
84 return (accountsCache, req)) |
119 return (accountsCache, req)) |
85 `Exception.onException` |
120 `Exception.onException` |