gameServer/HWProtoChecker.hs
author unc0rr
Fri, 30 Mar 2018 20:42:24 +0200
changeset 13306 806347b3c978
parent 11046 47a8c19ecb60
child 16012 2c92499daa67
permissions -rw-r--r--
Improve error message a bit
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
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    19
{-# LANGUAGE OverloadedStrings #-}
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    20
module HWProtoChecker where
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    21
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    22
import Data.Maybe
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    23
import Control.Monad.Reader
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    24
--------------------------------------
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    25
import CoreTypes
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    26
import HandlerUtils
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    27
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    28
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    29
handleCmd_checker :: CmdHandler
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    30
9433
f0a8ac191839 Push demo to idle checker on game finish
unc0rr
parents: 9109
diff changeset
    31
handleCmd_checker ["READY"] = return [ModifyClient $ \c -> c{isReady = True}, CheckRecord]
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    32
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    33
handleCmd_checker ["CHECKED", "FAIL", msg] = do
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    34
    isChecking <- liftM (isJust . checkInfo) thisClient
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    35
    if not isChecking then
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    36
        return []
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    37
        else
9444
30748b1d9ec7 Fix checker ready status mess
unc0rr
parents: 9433
diff changeset
    38
        return [CheckFailed msg, ModifyClient $ \c -> c{checkInfo = Nothing}]
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    39
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    40
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    41
handleCmd_checker ("CHECKED" : "OK" : info) = do
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    42
    isChecking <- liftM (isJust . checkInfo) thisClient
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    43
    if not isChecking then
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    44
        return []
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    45
        else
9444
30748b1d9ec7 Fix checker ready status mess
unc0rr
parents: 9433
diff changeset
    46
        return [CheckSuccess info, ModifyClient $ \c -> c{checkInfo = Nothing}]
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    47
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    48
handleCmd_checker _ = return [ProtocolError "Unknown command"]