95 lines
4.4 KiB
Common Lisp
95 lines
4.4 KiB
Common Lisp
(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))))))
|
|
((equal type "admin"))
|
|
((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)
|
|
(string-downcase
|
|
(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)))
|
|
(if dir
|
|
(refresh game :dir dir)
|
|
(refresh game))
|
|
(string-downcase
|
|
(to-json
|
|
(append (list :type "state") (dump gm game-id)))))))
|
|
|
|
;;; TODO: debug this function
|
|
(defmethod handle-admin ((api api) data)
|
|
(with-slots (gm) api
|
|
(let* ((game-id (getf data :game-id))
|
|
(cmd (getf data :cmd))
|
|
(arg (getf data :arg))
|
|
(game (get-game gm game-id)))
|
|
(cond
|
|
((equal cmd "move") (admin game :move arg)))))
|
|
"Command executed!")
|
|
|
|
(defmethod handle-request ((api api) request)
|
|
;; Catch request error and send it to the client
|
|
(handler-case
|
|
(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))
|
|
((equal type "admin") (handle-admin api data))
|
|
(t (format t "Unknow type"))))
|
|
(error (condition) ; Send reason to the client
|
|
(let ((reason (make-array 0
|
|
:element-type 'character
|
|
:adjustable t
|
|
:fill-pointer 0)))
|
|
(if (typep condition 'jonathan.error:<jonathan-error>)
|
|
(format reason "{\"type\":\"error\",\"message\":\"Failed to parse JSON\"}~%" condition :escape nil)
|
|
(format reason "{\"type\":\"error\",\"message\":\"~a\"}~%" condition :escape nil))
|
|
reason))))
|
|
|
|
|
|
|