gameServer/HandlerUtils.hs
author S.D.
Tue, 27 Sep 2022 14:59:03 +0300
changeset 15900 fc3cb23fd26f
parent 11046 47a8c19ecb60
child 15909 7409084d891f
child 16012 2c92499daa67
permissions -rw-r--r--
Allow to see rooms of incompatible versions in the lobby For the new clients the room version is shown in a separate column. There is also a hack for previous versions clients: the room vesion specifier is prepended to the room names for rooms of incompatible versions, and the server shows 'incompatible version' error if the client tries to join them.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10460
diff changeset
     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
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    19
module HandlerUtils where
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    20
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    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
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    23
import Data.List
15900
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 11046
diff changeset
    24
import Data.Word
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    25
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    26
import RoomsAndClients
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    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
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    29
10212
5fb3bb2de9d2 Some fixes to voting + small refactoring
unc0rr
parents: 10194
diff changeset
    30
type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
5fb3bb2de9d2 Some fixes to voting + small refactoring
unc0rr
parents: 10194
diff changeset
    31
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    32
thisClient :: Reader (ClientIndex, IRnC) ClientInfo
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    33
thisClient = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    34
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    35
    return $ rnc `client` ci
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    36
3568
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    37
thisRoom :: Reader (ClientIndex, IRnC) RoomInfo
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    38
thisRoom = do
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    39
    (ci, rnc) <- ask
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    40
    let ri = clientRoom rnc ci
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    41
    return $ rnc `room` ri
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    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
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    44
clientNick = liftM nick thisClient
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    45
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    46
roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    47
roomOthersChans = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    48
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    49
    let ri = clientRoom rnc ci
3542
f216b24aeb7f - Fix a function
unc0rr
parents: 3501
diff changeset
    50
    return $ map (sendChan . client rnc) $ filter (/= ci) (roomClients rnc ri)
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    51
4614
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    52
roomSameClanChans :: Reader (ClientIndex, IRnC) [ClientChan]
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    53
roomSameClanChans = do
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    54
    (ci, rnc) <- ask
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    55
    let ri = clientRoom rnc ci
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    56
    let otherRoomClients = map (client rnc) . filter (/= ci) $ roomClients rnc ri
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    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
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    60
3543
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    61
roomClientsChans :: Reader (ClientIndex, IRnC) [ClientChan]
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    62
roomClientsChans = do
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    63
    (ci, rnc) <- ask
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    64
    let ri = clientRoom rnc ci
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    65
    return $ map (sendChan . client rnc) (roomClients rnc ri)
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    66
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    67
thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    68
thisClientChans = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    69
    (ci, rnc) <- ask
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4614
diff changeset
    70
    return [sendChan (rnc `client` ci)]
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    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
15900
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
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4986
diff changeset
    83
answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4614
diff changeset
    84
answerClient msg = liftM ((: []) . flip AnswerClients msg) thisClientChans
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    85
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    86
allRoomInfos :: Reader (a, IRnC) [RoomInfo]
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    87
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask
4614
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    88
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    89
clientByNick :: B.ByteString -> Reader (ClientIndex, IRnC) (Maybe ClientIndex)
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    90
clientByNick n = do
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    91
    (_, rnc) <- ask
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    92
    let allClientIDs = allClients rnc
9433
f0a8ac191839 Push demo to idle checker on game finish
unc0rr
parents: 9109
diff changeset
    93
    return $ find (\clId -> let cl = client rnc clId in n == nick cl && not (isChecker cl)) allClientIDs
4614
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    94
10194
7025bd3c3131 Allow to save and delete room config in room
unc0rr
parents: 9433
diff changeset
    95
7025bd3c3131 Allow to save and delete room config in room
unc0rr
parents: 9433
diff changeset
    96
roomAdminOnly :: Reader (ClientIndex, IRnC) [Action] -> Reader (ClientIndex, IRnC) [Action]
7025bd3c3131 Allow to save and delete room config in room
unc0rr
parents: 9433
diff changeset
    97
roomAdminOnly h = thisClient >>= \cl -> if isMaster cl then h else return []
7025bd3c3131 Allow to save and delete room config in room
unc0rr
parents: 9433
diff changeset
    98
7025bd3c3131 Allow to save and delete room config in room
unc0rr
parents: 9433
diff changeset
    99
7025bd3c3131 Allow to save and delete room config in room
unc0rr
parents: 9433
diff changeset
   100
serverAdminOnly :: Reader (ClientIndex, IRnC) [Action] -> Reader (ClientIndex, IRnC) [Action]
7025bd3c3131 Allow to save and delete room config in room
unc0rr
parents: 9433
diff changeset
   101
serverAdminOnly h = thisClient >>= \cl -> if isAdministrator cl then h else return []