gameServer/Utils.hs
author unc0rr
Tue, 11 Apr 2023 09:30:56 +0200
changeset 15951 5aed6c0b63e2
parent 15879 4c58b320056c
permissions -rw-r--r--
Start PoC of pas2rust conversion routine
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10351
diff changeset
     1
{-
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10351
diff changeset
     2
 * Hedgewars, a free turn based strategy game
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10718
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: 10351
diff changeset
     4
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10351
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: 10351
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: 10351
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10351
diff changeset
     8
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10351
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: 10351
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: 10351
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10351
diff changeset
    12
 * GNU General Public License for more details.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10351
diff changeset
    13
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10351
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: 10351
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: 10351
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: 10351
diff changeset
    17
 \-}
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10351
diff changeset
    18
14287
9f0d81213d65 Cut dependency on yaml for non-official server builds
unC0Rr
parents: 14064
diff changeset
    19
{-# LANGUAGE OverloadedStrings,CPP #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
module Utils where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
import Data.Char
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
import Data.Word
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
import qualified Data.Map as Map
6191
190a8e5d9956 Case-insensitive comparison of nicks
unc0rr
parents: 6068
diff changeset
    25
import qualified Data.Char as Char
1917
c94045b70142 - Better ip2string implementation
unc0rr
parents: 1804
diff changeset
    26
import Numeric
c94045b70142 - Better ip2string implementation
unc0rr
parents: 1804
diff changeset
    27
import Network.Socket
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1953
diff changeset
    28
import System.IO
1917
c94045b70142 - Better ip2string implementation
unc0rr
parents: 1804
diff changeset
    29
import qualified Data.List as List
2349
ba7a0813c532 Some fixes suggested by hlint
unc0rr
parents: 2310
diff changeset
    30
import Control.Monad
5030
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4975
diff changeset
    31
import qualified Data.ByteString.Lazy as BL
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    32
import qualified Data.ByteString.Char8 as B
6191
190a8e5d9956 Case-insensitive comparison of nicks
unc0rr
parents: 6068
diff changeset
    33
import qualified Data.ByteString.UTF8 as UTF8
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: 6370
diff changeset
    34
import Data.Maybe
14287
9f0d81213d65 Cut dependency on yaml for non-official server builds
unC0Rr
parents: 14064
diff changeset
    35
#if defined(OFFICIAL_SERVER)
13418
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
    36
import qualified Data.Aeson.Types as Aeson
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
    37
import qualified Data.Text as Text
14287
9f0d81213d65 Cut dependency on yaml for non-official server builds
unC0Rr
parents: 14064
diff changeset
    38
#endif
4975
31da8979e5b1 Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents: 4972
diff changeset
    39
-------------------------------------------------
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    41
1917
c94045b70142 - Better ip2string implementation
unc0rr
parents: 1804
diff changeset
    42
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    43
sockAddr2String :: SockAddr -> IO B.ByteString
15699
27eb5abd5058 update server network
Jens Petersen
parents: 15445
diff changeset
    44
sockAddr2String = liftM (B.pack . fromJust . fst) . getNameInfo [] True False
1917
c94045b70142 - Better ip2string implementation
unc0rr
parents: 1804
diff changeset
    45
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    46
maybeRead :: Read a => String -> Maybe a
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    47
maybeRead s = case reads s of
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    48
    [(x, rest)] | all isSpace rest -> Just x
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    49
    _         -> Nothing
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    51
teamToNet :: TeamInfo -> [B.ByteString]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    52
teamToNet team =
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    53
        "ADD_TEAM"
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    54
        : teamname team
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    55
        : teamgrave team
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    56
        : teamfort team
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    57
        : teamvoicepack team
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    58
        : teamflag team
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    59
        : teamowner team
5030
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4975
diff changeset
    60
        : (showB . difficulty $ team)
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    61
        : hhsInfo
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    62
    where
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    63
        hhsInfo = concatMap (\(HedgehogInfo n hat) -> [n, hat]) $ hedgehogs team
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    64
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    65
modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    66
modifyTeam team room = room{teams = replaceTeam team $ teams room}
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    67
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    68
    replaceTeam _ [] = error "modifyTeam: no such team"
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    69
    replaceTeam tm (t:ts) =
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    70
        if teamname tm == teamname t then
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    71
            tm : ts
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    72
        else
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    73
            t : replaceTeam tm ts
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    74
13079
81c154fd4380 More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents: 12834
diff changeset
    75
-- NOTE: Don't forget to update the error messages when you change the naming rules!
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    76
illegalName :: B.ByteString -> Bool
10063
52e293f14977 Handle chars and not bytes for usernames :-p
unc0rr
parents: 10062
diff changeset
    77
illegalName b = B.null b || length s > 40 || all isSpace s || isSpace (head s) || isSpace (last s) || any isIllegalChar s
5269
e32fc0fcaad0 Implement testing for illegal characters
unc0rr
parents: 5060
diff changeset
    78
    where
10063
52e293f14977 Handle chars and not bytes for usernames :-p
unc0rr
parents: 10062
diff changeset
    79
        s = UTF8.toString b
14064
12bfae554de5 Also ban special symbols block
unc0rr
parents: 13673
diff changeset
    80
        isIllegalChar c = c `List.elem` ("$()*+?[]^{|}\x7F" ++ ['\x00'..'\x1F'] ++ ['\xFFF0'..'\xFFFF'])
2150
45b695f3a7b9 Forbid room names and nicknames consisting only of space characters
unc0rr
parents: 2113
diff changeset
    81
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    82
protoNumber2ver :: Word16 -> B.ByteString
4569
a835465b4fd2 Convert function to a map
unc0rr
parents: 4337
diff changeset
    83
protoNumber2ver v = Map.findWithDefault "Unknown" v vermap
a835465b4fd2 Convert function to a map
unc0rr
parents: 4337
diff changeset
    84
    where
a835465b4fd2 Convert function to a map
unc0rr
parents: 4337
diff changeset
    85
        vermap = Map.fromList [
4936
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    86
            (17, "0.9.7-dev")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    87
            , (19, "0.9.7")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    88
            , (20, "0.9.8-dev")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    89
            , (21, "0.9.8")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    90
            , (22, "0.9.9-dev")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    91
            , (23, "0.9.9")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    92
            , (24, "0.9.10-dev")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    93
            , (25, "0.9.10")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    94
            , (26, "0.9.11-dev")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    95
            , (27, "0.9.11")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    96
            , (28, "0.9.12-dev")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    97
            , (29, "0.9.12")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    98
            , (30, "0.9.13-dev")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
    99
            , (31, "0.9.13")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
   100
            , (32, "0.9.14-dev")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
   101
            , (33, "0.9.14")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
   102
            , (34, "0.9.15-dev")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
   103
            , (35, "0.9.14.1")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
   104
            , (37, "0.9.15")
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
   105
            , (38, "0.9.16-dev")
5880
a6573cc5903e Add 0.9.16 and 0.9.17-dev version info to server
unc0rr
parents: 5269
diff changeset
   106
            , (39, "0.9.16")
a6573cc5903e Add 0.9.16 and 0.9.17-dev version info to server
unc0rr
parents: 5269
diff changeset
   107
            , (40, "0.9.17-dev")
6370
fb9aeddcb046 Make server know release version
unc0rr
parents: 6191
diff changeset
   108
            , (41, "0.9.17")
fb9aeddcb046 Make server know release version
unc0rr
parents: 6191
diff changeset
   109
            , (42, "0.9.18-dev")
7862
bd76ca40db68 Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents: 7766
diff changeset
   110
            , (43, "0.9.18")
bd76ca40db68 Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents: 7766
diff changeset
   111
            , (44, "0.9.19-dev")
9086
77f471657230 ++protocol_number;
unc0rr
parents: 8777
diff changeset
   112
            , (45, "0.9.19")
77f471657230 ++protocol_number;
unc0rr
parents: 8777
diff changeset
   113
            , (46, "0.9.20-dev")
9837
fa94ee96f006 Make server aware of new versions
unc0rr
parents: 9753
diff changeset
   114
            , (47, "0.9.20")
fa94ee96f006 Make server aware of new versions
unc0rr
parents: 9753
diff changeset
   115
            , (48, "0.9.21-dev")
10718
40dda24ee145 More complete fix for FULLMAPCONFIG message, also add new known protocol versions
unc0rr
parents: 10602
diff changeset
   116
            , (49, "0.9.21")
40dda24ee145 More complete fix for FULLMAPCONFIG message, also add new known protocol versions
unc0rr
parents: 10602
diff changeset
   117
            , (50, "0.9.22-dev")
11265
35e359585dea Update versions information
unc0rr
parents: 11046
diff changeset
   118
            , (51, "0.9.22")
35e359585dea Update versions information
unc0rr
parents: 11046
diff changeset
   119
            , (52, "0.9.23-dev")
12834
148c9524f38d Bump protocol version and add new version info to game server
unc0rr
parents: 12114
diff changeset
   120
            , (53, "0.9.23")
148c9524f38d Bump protocol version and add new version info to game server
unc0rr
parents: 12114
diff changeset
   121
            , (54, "0.9.24-dev")
13303
e3613c0d3600 Bump protocol version, update sources in preparation for .24 release
unc0rr
parents: 13079
diff changeset
   122
            , (55, "0.9.24")
e3613c0d3600 Bump protocol version, update sources in preparation for .24 release
unc0rr
parents: 13079
diff changeset
   123
            , (56, "0.9.25-dev")
14353
5cc671f988e7 Make server aware of new protocol versions
unc0rr
parents: 14287
diff changeset
   124
            , (57, "0.9.25")
5cc671f988e7 Make server aware of new protocol versions
unc0rr
parents: 14287
diff changeset
   125
            , (58, "1.0.0-dev")
15445
88770c206c31 Bump protocol version to 59
Wuzzy <Wuzzy2@mail.ru>
parents: 14353
diff changeset
   126
            , (59, "1.0.0")
15879
4c58b320056c Change the next major release version number to 1.1.0
S.D.
parents: 15878
diff changeset
   127
            , (60, "1.1.0-dev")
4936
d65d438acd23 Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents: 4932
diff changeset
   128
            ]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   129
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4904
diff changeset
   130
askFromConsole :: B.ByteString -> IO B.ByteString
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1953
diff changeset
   131
askFromConsole msg = do
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4904
diff changeset
   132
    B.putStr msg
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   133
    hFlush stdout
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4904
diff changeset
   134
    B.getLine
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   135
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   136
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   137
unfoldrE :: (b -> Either b (a, b)) -> b -> ([a], b)
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   138
unfoldrE f b  =
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   139
    case f b of
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   140
        Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b')
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   141
        Left new_b       -> ([], new_b)
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   142
11838
8f730ba4ca3c bytestring-show RIP
unc0rr
parents: 11575
diff changeset
   143
showB :: (Show a) => a -> B.ByteString
8f730ba4ca3c bytestring-show RIP
unc0rr
parents: 11575
diff changeset
   144
showB = B.pack . show
5030
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4975
diff changeset
   145
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4975
diff changeset
   146
readInt_ :: (Num a) => B.ByteString -> a
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4975
diff changeset
   147
readInt_ str =
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4975
diff changeset
   148
  case B.readInt str of
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4975
diff changeset
   149
       Just (i, t) | B.null t -> fromIntegral i
10017
de822cd3df3a fixwhitespace and dos2unix
koda
parents: 9837
diff changeset
   150
       _                      -> 0
5060
7d0f6e5b1c1c Hide last two octets of IP address from usual users
unc0rr
parents: 5030
diff changeset
   151
7d0f6e5b1c1c Hide last two octets of IP address from usual users
unc0rr
parents: 5030
diff changeset
   152
cutHost :: B.ByteString -> B.ByteString
7d0f6e5b1c1c Hide last two octets of IP address from usual users
unc0rr
parents: 5030
diff changeset
   153
cutHost = B.intercalate "." .  flip (++) ["*","*"] . List.take 2 . B.split '.'
6191
190a8e5d9956 Case-insensitive comparison of nicks
unc0rr
parents: 6068
diff changeset
   154
190a8e5d9956 Case-insensitive comparison of nicks
unc0rr
parents: 6068
diff changeset
   155
caseInsensitiveCompare :: B.ByteString -> B.ByteString -> Bool
8396
5123eac2f9d6 - Pass unknown chat commands to server
unc0rr
parents: 7862
diff changeset
   156
caseInsensitiveCompare a b = upperCase a == upperCase b
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: 6370
diff changeset
   157
8396
5123eac2f9d6 - Pass unknown chat commands to server
unc0rr
parents: 7862
diff changeset
   158
upperCase :: B.ByteString -> B.ByteString
5123eac2f9d6 - Pass unknown chat commands to server
unc0rr
parents: 7862
diff changeset
   159
upperCase = UTF8.fromString . map Char.toUpper . UTF8.toString
7766
98edc0724a28 Fix most of server warnings
unc0rr
parents: 6981
diff changeset
   160
15878
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   161
roomNameByProto :: B.ByteString -> Word16 -> Word16 -> B.ByteString
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   162
roomNameByProto roomName roomProto clientProto
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   163
    | clientProto < 60 && roomProto /= clientProto = B.concat [B.pack "[v", protoNumber2ver roomProto, B.pack "] ", roomName]
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   164
    | otherwise = roomName
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   165
9702
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   166
roomInfo :: Word16 -> B.ByteString -> RoomInfo -> [B.ByteString]
10017
de822cd3df3a fixwhitespace and dos2unix
koda
parents: 9837
diff changeset
   167
roomInfo p n r
9702
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   168
    | p < 46 = [
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: 6370
diff changeset
   169
        showB $ isJust $ gameInfo r,
15878
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   170
        roomNameByProto (name r) (roomProto r) p,
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: 6370
diff changeset
   171
        showB $ playersIn r,
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: 6370
diff changeset
   172
        showB $ length $ teams r,
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: 6370
diff changeset
   173
        n,
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: 6370
diff changeset
   174
        Map.findWithDefault "+rnd+" "MAP" (mapParams r),
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: 6370
diff changeset
   175
        head (Map.findWithDefault ["Default"] "SCHEME" (params r)),
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: 6370
diff changeset
   176
        head (Map.findWithDefault ["Default"] "AMMO" (params r))
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: 6370
diff changeset
   177
        ]
10511
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   178
    | p < 48 = [
9702
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   179
        showB $ isJust $ gameInfo r,
15878
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   180
        roomNameByProto (name r) (roomProto r) p,
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   181
        showB $ playersIn r,
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   182
        showB $ length $ teams r,
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   183
        n,
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   184
        Map.findWithDefault "+rnd+" "MAP" (mapParams r),
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   185
        head (Map.findWithDefault ["Normal"] "SCRIPT" (params r)),
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   186
        head (Map.findWithDefault ["Default"] "SCHEME" (params r)),
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   187
        head (Map.findWithDefault ["Default"] "AMMO" (params r))
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   188
        ]
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   189
    | p < 60 = [
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   190
        B.pack roomFlags,
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   191
        roomNameByProto (name r) (roomProto r) p,
9702
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   192
        showB $ playersIn r,
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   193
        showB $ length $ teams r,
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   194
        n,
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   195
        Map.findWithDefault "+rnd+" "MAP" (mapParams r),
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   196
        head (Map.findWithDefault ["Normal"] "SCRIPT" (params r)),
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   197
        head (Map.findWithDefault ["Default"] "SCHEME" (params r)),
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   198
        head (Map.findWithDefault ["Default"] "AMMO" (params r))
27006953d901 - Column for script in rooms list
unc0rr
parents: 9448
diff changeset
   199
        ]
10511
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   200
    | otherwise = [
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   201
        B.pack roomFlags,
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   202
        name r,
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   203
        showB $ playersIn r,
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   204
        showB $ length $ teams r,
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   205
        n,
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   206
        Map.findWithDefault "+rnd+" "MAP" (mapParams r),
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   207
        head (Map.findWithDefault ["Normal"] "SCRIPT" (params r)),
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   208
        head (Map.findWithDefault ["Default"] "SCHEME" (params r)),
15878
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   209
        head (Map.findWithDefault ["Default"] "AMMO" (params r)),
fc3cb23fd26f Allow to see rooms of incompatible versions in the lobby
S.D.
parents: 15699
diff changeset
   210
        showB $ roomProto r
10511
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   211
        ]
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   212
    where
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   213
        roomFlags = concat [
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   214
            "-"
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   215
            , ['g' | isJust $ gameInfo r]
10524
2bc0ff00e95b password flag was the wrong way around
sheepluva
parents: 10511
diff changeset
   216
            , ['p' | not . B.null $ password r]
10511
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   217
            , ['j' | isRestrictedJoins  r]
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   218
            , ['r' | isRegisteredOnly  r]
c33b2f001730 This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents: 10460
diff changeset
   219
            ]
9109
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   220
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   221
answerFullConfigParams ::
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   222
            ClientInfo
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   223
            -> Map.Map B.ByteString B.ByteString
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   224
            -> Map.Map B.ByteString [B.ByteString]
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   225
            -> [Action]
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   226
answerFullConfigParams cl mpr pr
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   227
        | clientProto cl < 38 = map (toAnswer cl) $
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   228
                (reverse . map (\(a, b) -> (a, [b])) $ Map.toList mpr)
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   229
                ++ (("SCHEME", pr Map.! "SCHEME")
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   230
                : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr))
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   231
10602
1ec0268f28af Fix FULLMAPCONFIG message
unC0Rr
parents: 10524
diff changeset
   232
        | clientProto cl < 48 = map (toAnswer cl) $
10718
40dda24ee145 More complete fix for FULLMAPCONFIG message, also add new known protocol versions
unc0rr
parents: 10602
diff changeset
   233
                ("FULLMAPCONFIG", let l = Map.elems mpr in if length l > 5 then tail l else l)
10602
1ec0268f28af Fix FULLMAPCONFIG message
unC0Rr
parents: 10524
diff changeset
   234
                : ("SCHEME", pr Map.! "SCHEME")
1ec0268f28af Fix FULLMAPCONFIG message
unC0Rr
parents: 10524
diff changeset
   235
                : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr)
1ec0268f28af Fix FULLMAPCONFIG message
unC0Rr
parents: 10524
diff changeset
   236
9109
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   237
        | otherwise = map (toAnswer cl) $
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   238
                ("FULLMAPCONFIG", Map.elems mpr)
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   239
                : ("SCHEME", pr Map.! "SCHEME")
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   240
                : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr)
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   241
    where
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   242
        toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   243
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 9086
diff changeset
   244
9448
04e0acfa7c2c /watch works in testing environment
unc0rr
parents: 9109
diff changeset
   245
answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
04e0acfa7c2c /watch works in testing environment
unc0rr
parents: 9109
diff changeset
   246
answerAllTeams cl = concatMap toAnswer
04e0acfa7c2c /watch works in testing environment
unc0rr
parents: 9109
diff changeset
   247
    where
04e0acfa7c2c /watch works in testing environment
unc0rr
parents: 9109
diff changeset
   248
        clChan = sendChan cl
04e0acfa7c2c /watch works in testing environment
unc0rr
parents: 9109
diff changeset
   249
        toAnswer team =
04e0acfa7c2c /watch works in testing environment
unc0rr
parents: 9109
diff changeset
   250
            [AnswerClients [clChan] $ teamToNet team,
04e0acfa7c2c /watch works in testing environment
unc0rr
parents: 9109
diff changeset
   251
            AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team],
04e0acfa7c2c /watch works in testing environment
unc0rr
parents: 9109
diff changeset
   252
            AnswerClients [clChan] ["HH_NUM", teamname team, showB $ hhnum team]]
04e0acfa7c2c /watch works in testing environment
unc0rr
parents: 9109
diff changeset
   253
04e0acfa7c2c /watch works in testing environment
unc0rr
parents: 9109
diff changeset
   254
13673
1aa5e884326a Fix some string/translation inconsistencies in strings related to leaving
Wuzzy <Wuzzy2@mail.ru>
parents: 13418
diff changeset
   255
-- Locale function to localize strings.
1aa5e884326a Fix some string/translation inconsistencies in strings related to leaving
Wuzzy <Wuzzy2@mail.ru>
parents: 13418
diff changeset
   256
-- loc is just the identity functions, but it will be collected by scripts
1aa5e884326a Fix some string/translation inconsistencies in strings related to leaving
Wuzzy <Wuzzy2@mail.ru>
parents: 13418
diff changeset
   257
-- for localization. Use loc to mark a string for translation.
8401
87410ae372f6 Server messages localization using Qt's l10n subsystem:
unc0rr
parents: 8396
diff changeset
   258
loc :: B.ByteString -> B.ByteString
87410ae372f6 Server messages localization using Qt's l10n subsystem:
unc0rr
parents: 8396
diff changeset
   259
loc = id
9753
9579596cf471 - Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents: 9702
diff changeset
   260
9579596cf471 - Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents: 9702
diff changeset
   261
maybeNick :: Maybe ClientInfo -> B.ByteString
10351
0eff41e9f63f Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents: 10063
diff changeset
   262
maybeNick = fromMaybe "[]" . liftM nick
0eff41e9f63f Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents: 10063
diff changeset
   263
0eff41e9f63f Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents: 10063
diff changeset
   264
-- borrowed from Data.List, just more general in types
0eff41e9f63f Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents: 10063
diff changeset
   265
deleteBy2                :: (a -> b -> Bool) -> a -> [b] -> [b]
0eff41e9f63f Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents: 10063
diff changeset
   266
deleteBy2 _  _ []        = []
0eff41e9f63f Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents: 10063
diff changeset
   267
deleteBy2 eq x (y:ys)    = if x `eq` y then ys else y : deleteBy2 eq x ys
0eff41e9f63f Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents: 10063
diff changeset
   268
0eff41e9f63f Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents: 10063
diff changeset
   269
deleteFirstsBy2          :: (a -> b -> Bool) -> [a] -> [b] -> [a]
0eff41e9f63f Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents: 10063
diff changeset
   270
deleteFirstsBy2 eq       =  foldl (flip (deleteBy2 (flip eq)))
0eff41e9f63f Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents: 10063
diff changeset
   271
11575
db7743e2fad1 More work on best time ghost feature
unc0rr
parents: 11265
diff changeset
   272
sanitizeName :: B.ByteString -> B.ByteString
db7743e2fad1 More work on best time ghost feature
unc0rr
parents: 11265
diff changeset
   273
sanitizeName = B.map sc
db7743e2fad1 More work on best time ghost feature
unc0rr
parents: 11265
diff changeset
   274
    where
db7743e2fad1 More work on best time ghost feature
unc0rr
parents: 11265
diff changeset
   275
        sc c | isAlphaNum c = c
db7743e2fad1 More work on best time ghost feature
unc0rr
parents: 11265
diff changeset
   276
             | otherwise = '_'
12114
cdadc1d487f1 Only registered players regain their teams on rejoin
unc0rr
parents: 11838
diff changeset
   277
cdadc1d487f1 Only registered players regain their teams on rejoin
unc0rr
parents: 11838
diff changeset
   278
isRegistered :: ClientInfo -> Bool
cdadc1d487f1 Only registered players regain their teams on rejoin
unc0rr
parents: 11838
diff changeset
   279
isRegistered = (<) 0 . B.length . webPassword
13418
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   280
14287
9f0d81213d65 Cut dependency on yaml for non-official server builds
unC0Rr
parents: 14064
diff changeset
   281
#if defined(OFFICIAL_SERVER)
13418
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   282
instance Aeson.ToJSON B.ByteString where
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   283
  toJSON = Aeson.toJSON . B.unpack
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   284
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   285
instance Aeson.FromJSON B.ByteString where
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   286
  parseJSON = Aeson.withText "ByteString" $ pure . B.pack . Text.unpack
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   287
  
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   288
instance Aeson.ToJSONKey B.ByteString where
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   289
  toJSONKey = Aeson.toJSONKeyText (Text.pack . B.unpack)
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   290
  
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   291
instance Aeson.FromJSONKey B.ByteString where
bb24c3414b0d Store saved room in yaml
unc0rr
parents: 13303
diff changeset
   292
  fromJSONKey = Aeson.FromJSONKeyTextParser (return . B.pack . Text.unpack)
14287
9f0d81213d65 Cut dependency on yaml for non-official server builds
unC0Rr
parents: 14064
diff changeset
   293
#endif