author | jpr |
Fri, 27 Jan 2023 06:22:22 +0300 | |
changeset 15911 | 5289ab63853d |
parent 15878 | fc3cb23fd26f |
child 15983 | 2c92499daa67 |
permissions | -rw-r--r-- |
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
1 |
{- |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
2 |
* Hedgewars, a free turn based strategy game |
11046 | 3 |
* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com> |
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
4 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
5 |
* This program is free software; you can redistribute it and/or modify |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
6 |
* it under the terms of the GNU General Public License as published by |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
7 |
* the Free Software Foundation; version 2 of the License |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
8 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
9 |
* This program is distributed in the hope that it will be useful, |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
10 |
* but WITHOUT ANY WARRANTY; without even the implied warranty of |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
11 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
12 |
* GNU General Public License for more details. |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
13 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
14 |
* You should have received a copy of the GNU General Public License |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
15 |
* along with this program; if not, write to the Free Software |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
16 |
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
17 |
\-} |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
18 |
|
3435 | 19 |
module HandlerUtils where |
20 |
||
21 |
import Control.Monad.Reader |
|
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3435
diff
changeset
|
22 |
import qualified Data.ByteString.Char8 as B |
4614 | 23 |
import Data.List |
15878
fc3cb23fd26f
Allow to see rooms of incompatible versions in the lobby
S.D.
parents:
11046
diff
changeset
|
24 |
import Data.Word |
3435 | 25 |
|
26 |
import RoomsAndClients |
|
27 |
import CoreTypes |
|
9109
878f06e9c484
- Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents:
6541
diff
changeset
|
28 |
|
3435 | 29 |
|
10212 | 30 |
type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
31 |
||
3435 | 32 |
thisClient :: Reader (ClientIndex, IRnC) ClientInfo |
33 |
thisClient = do |
|
34 |
(ci, rnc) <- ask |
|
35 |
return $ rnc `client` ci |
|
36 |
||
3568 | 37 |
thisRoom :: Reader (ClientIndex, IRnC) RoomInfo |
38 |
thisRoom = do |
|
39 |
(ci, rnc) <- ask |
|
40 |
let ri = clientRoom rnc ci |
|
41 |
return $ rnc `room` ri |
|
42 |
||
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3435
diff
changeset
|
43 |
clientNick :: Reader (ClientIndex, IRnC) B.ByteString |
3435 | 44 |
clientNick = liftM nick thisClient |
45 |
||
46 |
roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan] |
|
47 |
roomOthersChans = do |
|
48 |
(ci, rnc) <- ask |
|
49 |
let ri = clientRoom rnc ci |
|
3542 | 50 |
return $ map (sendChan . client rnc) $ filter (/= ci) (roomClients rnc ri) |
3435 | 51 |
|
4614 | 52 |
roomSameClanChans :: Reader (ClientIndex, IRnC) [ClientChan] |
53 |
roomSameClanChans = do |
|
54 |
(ci, rnc) <- ask |
|
55 |
let ri = clientRoom rnc ci |
|
56 |
let otherRoomClients = map (client rnc) . filter (/= ci) $ roomClients rnc ri |
|
57 |
let cl = rnc `client` ci |
|
4986
33fe91b2bcbf
Use Maybe for storing client's clan, allows less error-prone spectator checks
unc0rr
parents:
4975
diff
changeset
|
58 |
let sameClanClients = Prelude.filter (\c -> clientClan c == clientClan cl) otherRoomClients |
33fe91b2bcbf
Use Maybe for storing client's clan, allows less error-prone spectator checks
unc0rr
parents:
4975
diff
changeset
|
59 |
return $ map sendChan sameClanClients |
4614 | 60 |
|
3543 | 61 |
roomClientsChans :: Reader (ClientIndex, IRnC) [ClientChan] |
62 |
roomClientsChans = do |
|
63 |
(ci, rnc) <- ask |
|
64 |
let ri = clientRoom rnc ci |
|
65 |
return $ map (sendChan . client rnc) (roomClients rnc ri) |
|
66 |
||
3435 | 67 |
thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan] |
68 |
thisClientChans = do |
|
69 |
(ci, rnc) <- ask |
|
4932 | 70 |
return [sendChan (rnc `client` ci)] |
3435 | 71 |
|
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
72 |
sameProtoChans :: Reader (ClientIndex, IRnC) [ClientChan] |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
73 |
sameProtoChans = do |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
74 |
(ci, rnc) <- ask |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
75 |
let p = clientProto (rnc `client` ci) |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
76 |
return . map sendChan . filter (\c -> clientProto c == p) . map (client rnc) $ allClients rnc |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
77 |
|
15878
fc3cb23fd26f
Allow to see rooms of incompatible versions in the lobby
S.D.
parents:
11046
diff
changeset
|
78 |
allChansProto :: Reader (ClientIndex, IRnC) [(ClientChan, Word16)] |
fc3cb23fd26f
Allow to see rooms of incompatible versions in the lobby
S.D.
parents:
11046
diff
changeset
|
79 |
allChansProto = do |
fc3cb23fd26f
Allow to see rooms of incompatible versions in the lobby
S.D.
parents:
11046
diff
changeset
|
80 |
(ci, rnc) <- ask |
fc3cb23fd26f
Allow to see rooms of incompatible versions in the lobby
S.D.
parents:
11046
diff
changeset
|
81 |
return . map ((\c -> (sendChan c, clientProto c)) . client rnc) $ allClients rnc |
fc3cb23fd26f
Allow to see rooms of incompatible versions in the lobby
S.D.
parents:
11046
diff
changeset
|
82 |
|
4989 | 83 |
answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
4932 | 84 |
answerClient msg = liftM ((: []) . flip AnswerClients msg) thisClientChans |
3501 | 85 |
|
86 |
allRoomInfos :: Reader (a, IRnC) [RoomInfo] |
|
87 |
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask |
|
4614 | 88 |
|
89 |
clientByNick :: B.ByteString -> Reader (ClientIndex, IRnC) (Maybe ClientIndex) |
|
90 |
clientByNick n = do |
|
91 |
(_, rnc) <- ask |
|
92 |
let allClientIDs = allClients rnc |
|
9433 | 93 |
return $ find (\clId -> let cl = client rnc clId in n == nick cl && not (isChecker cl)) allClientIDs |
4614 | 94 |
|
10194 | 95 |
|
96 |
roomAdminOnly :: Reader (ClientIndex, IRnC) [Action] -> Reader (ClientIndex, IRnC) [Action] |
|
97 |
roomAdminOnly h = thisClient >>= \cl -> if isMaster cl then h else return [] |
|
98 |
||
99 |
||
100 |
serverAdminOnly :: Reader (ClientIndex, IRnC) [Action] -> Reader (ClientIndex, IRnC) [Action] |
|
101 |
serverAdminOnly h = thisClient >>= \cl -> if isAdministrator cl then h else return [] |