blob: 6c99ea8585b34a08c572d89679075443fb0a8bdb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
(in-package :remote-snake-server-api)
(defclass api ()
((gm
:initform (make-instance 'game-manager))))
(define-condition bad-request (error)
((msg
:reader bad-request-msg
:initarg :msg
:initform "Unkown error occurs"))
(:report (lambda (condition stream) (format stream "Bad Request: ~a" (bad-request-msg condition)))))
;;; Parse the request and return it as a plist
;;; TODO Check game using game-manager (create the right error condition in gm)
(defun parse-request (request)
(flet ((normalizer (key) (string-upcase key)))
(let* ((p-request (parse request :normalize-all t :keyword-normalizer #'normalizer ))
(type (getf p-request :type :not-found)))
(cond
((eq type :not-found)
(error 'bad-request :msg "No json \"type\" field provided"))
((equal type "update")
(progn
(unless (getf p-request :game-id) (error 'bad-request :msg "No json \"game-id\" field provided"))
(let ((dir (getf p-request :direction :not-found)))
(when (eq :not-found dir) (error 'bad-request :msg "No json \"direction\" field provided"))
(unless (or (equal "up" dir) (equal "down" dir) (equal "left" dir) (equal "right" dir) (eq nil dir)) (error 'bad-request :msg "Bad \"direction\" field value"))
(cond
((equal dir "up") (setf (getf p-request :direction) :up))
((equal dir "down") (setf (getf p-request :direction) :down))
((equal dir "left") (setf (getf p-request :direction) :left))
((equal dir "right") (setf (getf p-request :direction) :right))))))
((not (equal type "new-game"))
(error 'bad-request :msg "Unknown request type")))
p-request)))
(defmethod handle-new-game ((api api) data)
(with-slots (gm) api
(let* ((game-id (create-game gm)))
(let ((game-dump (dump gm game-id)))
(setf (getf game-dump :game-over) :null) ; Define nil as null (for json)
(to-json
(append (list :type "state") game-dump))))))
(defmethod handle-update ((api api) data)
(with-slots (gm) api
(let* ((dir (getf data :direction))
(game-id (getf data :game-id))
(game (get-game gm game-id)))
(cond
((equal dir "up") (setf dir :up))
((equal dir "down") (setf dir :down))
((equal dir "left") (setf dir :left))
((equal dir "right") (setf dir :right))
(t (setf dir nil)))
(if dir
(refresh game :dir dir)
(refresh game))
(to-json
(append (list :type "state") (dump gm game-id))))))
;;; TODO: Improve error management
(defmethod handle-request ((api api) request)
(flet ((handle-fun ()
(let* ((data (parse-request request))
(type (getf data :type)))
(cond
((equal type "new-game") (handle-new-game api data))
((equal type "update") (handle-update api data))
(t (format t "Unknow type"))))))
(handler-case
(handle-fun)
(t (c)
(format t "Got an exception: ~a~%" c)
"Bad request"))))
|
