diff --git a/backplane-server.asd b/backplane-server.asd index cf39478..1c2085e 100644 --- a/backplane-server.asd +++ b/backplane-server.asd @@ -11,4 +11,19 @@ :cl-xmpp :cl-xmpp-tls) :components ((:file "package") - (:file "backplane-server"))) + (:file "backplane-server")) + :in-order-to ((test-op (test-op :backplane-server/test)))) + +(asdf:defsystem #:backplane-server/test + :description "XMPP Backplane Server Tests" + :author "Niten " + :depends-on (:arrows + :backplane-server + :cl-json + :prove) + :defsystem-depends-on (:prove-asdf) + :components ((:module "test" + :serial t + :components ((:test-file "backplane-server-test")))) + :perform (asdf:test-op (op c) + (uiop:symbol-call :prove '#:run '#:backplane-server/test))) diff --git a/backplane-server.lisp b/backplane-server.lisp index 7b69e63..d1e14d3 100644 --- a/backplane-server.lisp +++ b/backplane-server.lisp @@ -14,7 +14,8 @@ :reader request))) (defclass result () - ((message :initarg :message) + ((message :initarg :message + :reader message) (msg-id :initarg :msg-id :reader msg-id))) @@ -70,9 +71,9 @@ (defun dispatch-parse-message (message sender) (if-let ((api-version (cdr (assoc :VERSION message))) - (service (symbolize (cdr (assoc :SERVICE message)))) + (service (cdr (assoc :SERVICE message))) (msg-id (cdr (assoc :MSGID message)))) - (parse-message sender service api-version (cdr (assoc :PAYLOAD message)) msg-id) + (parse-message sender (symbolize service) api-version (cdr (assoc :PAYLOAD message)) msg-id) (make-error :msg (format nil "missing api_version, msgid, or service name in request in message") :msg-id msg-id))) @@ -98,22 +99,27 @@ forms :initial-value init))))) +(defun handle-xmpp-message (sender body) + (render-result + (handler-case + (success-> body + (decode-message) + (dispatch-parse-message sender) + (handle-message)) + (error (e) + (format *error-output* "failed handling message from ~A: ~A" + sender e) + (make-error :msg "an unknown error occurred handling request"))))) + (defmethod xmpp:handle ((conn xmpp:connection) (message xmpp:message)) (let ((sender (xmpp:from message))) (format *standard-output* "message received from ~A" sender) (xmpp:message conn - (xmpp:from message) - (render-result - (handler-case - (success-> message - (xmpp:body) - (decode-message) - (dispatch-parse-message sender) - (handle-message)) - (error (e) - (format *error-output* "failed handling message from ~A: ~A" - sender e) - (make-error :msg "an unknown error occurred handling request"))))))) + sender + (handle-xmpp-message sender (xmpp:body message))))) + +(defun start-listening (backplane) + (xmpp:receive-stanza-loop backplane)) (let ((backplane nil)) (defun backplane-connect (xmpp-host xmpp-username xmpp-password) diff --git a/package.lisp b/package.lisp index 6f9ab62..4ffa734 100644 --- a/package.lisp +++ b/package.lisp @@ -17,5 +17,10 @@ #:error-p #:parse-message #:handle-message + #:handle-xmpp-message #:backplane-connect - #:with-backplane)) + #:start-listening + #:with-backplane + #:message + #:result/success + #:result/error)) diff --git a/test/backplane-server-test.lisp b/test/backplane-server-test.lisp new file mode 100644 index 0000000..6386ce7 --- /dev/null +++ b/test/backplane-server-test.lisp @@ -0,0 +1,185 @@ +;;;; backplane-server-test.lisp + +(defpackage #:backplane-server/test + (:use #:cl + #:backplane-server + #:prove) + (:import-from #:arrows + #:-> + #:some->) + (:import-from #:cl-json + #:decode-json-from-string + #:encode-json-to-string)) + +(in-package #:backplane-server/test) + +(plan 21) + +(ok (error-p (make-error :msg-id 1 + :msg "oops"))) + +(ok (error-p (make-error :msg "oops"))) + +(ok (success-p (make-success :msg-id 1 + :msg "ok"))) + +(ok (success-p (make-success :msg "ok"))) + +(ok (not (success-p (make-error :msg-id 1 + :msg "oops")))) + +(ok (not (error-p (make-success :msg-id 1 + :msg "ok")))) + +(defun make-request (&key + (service :TEST) + (msgid 1) + (version 1) + (payload '())) + (encode-json-to-string + `((VERSION . ,version) + (SERVICE . ,service) + (MSGID . ,msgid) + (PAYLOAD . ,payload)))) + +(defun get-key (obj key) + (cdr (assoc key obj))) + +(defun handle (body) + (handle-xmpp-message "me" body)) + +(defun decode (body) + (cl-json:decode-json-from-string body)) + +(is (-> "}{" + (handle) + (decode) + (get-key :STATUS)) + "ERROR") + +(is (-> "}{" + (handle) + (decode) + (get-key :MESSAGE)) + "invalid json string: }{") + +(is (-> (make-request :service :NONEXISTENT) + (handle) + (decode) + (get-key :STATUS)) + "ERROR") + +(is (-> (make-request :service :NONEXISTENT) + (handle) + (decode) + (get-key :MESSAGE)) + "unsupported service: NONEXISTENT") + +(is (-> (make-request :service nil) + (handle) + (decode) + (get-key :MESSAGE)) + "missing api_version, msgid, or service name in request in message") + +(is (-> (make-request :version nil) + (handle) + (decode) + (get-key :MESSAGE)) + "missing api_version, msgid, or service name in request in message") + +(is (-> (make-request :msgid nil) + (handle) + (decode) + (get-key :MESSAGE)) + "missing api_version, msgid, or service name in request in message") + +(defmethod parse-message (sender (service (eql :TEST0)) api-version message msg-id) + :TEST-SIMPLE-MESSAGE) + +(defmethod handle-message ((message (eql :TEST-SIMPLE-MESSAGE))) + (make-success :msg "successful-test0")) + +(is (-> (make-request :service :TEST0) + (handle) + (decode) + (get-key :STATUS)) + "OK") + +(is (-> (make-request :service :TEST0) + (handle) + (decode) + (get-key :MESSAGE)) + "successful-test0") + +(defclass my-req-type () + ((msg :initarg :msg) + (msgid :initarg :msgid))) + +(defclass my-succeeder (my-req-type) ()) + +(defclass my-failer (my-req-type) ()) + +(defmethod parse-message (sender (service (eql :TEST1)) api-version message msg-id) + (if (equalp message "succeed") + (make-instance 'my-succeeder + :msg "successful-test1" + :msgid msg-id) + (make-instance 'my-failer + :msg "failed-test1" + :msgid msg-id))) + +(defmethod handle-message ((req my-succeeder)) + (with-slots (msg msgid) req + (make-success :msg msg :msg-id msgid))) + +(defmethod handle-message ((req my-failer)) + (with-slots (msg msgid) req + (make-error :msg msg :msg-id msgid))) + +(is (-> (make-request :service :TEST1 + :payload "succeed") + (handle) + (decode) + (get-key :STATUS)) + "OK") + +(is (-> (make-request :service :TEST1 + :payload "succeed") + (handle) + (decode) + (get-key :MESSAGE)) + "successful-test1") + +(is (-> (make-request :service :TEST1 + :payload "fail plz") + (handle) + (decode) + (get-key :STATUS)) + "ERROR") + +(is (-> (make-request :service :TEST1 + :payload "fail plz") + (handle) + (decode) + (get-key :MESSAGE)) + "failed-test1") + +(let ((msg-id "testid0")) + (is (-> (make-request :service :TEST1 + :msgid msg-id + :payload "succeed") + (handle) + (decode) + (get-key :MSGID)) + msg-id)) + +(let ((msg-id "testid1")) + (is (-> (make-request :service :TEST1 + :msgid msg-id + :payload "fail pl'") + (handle) + (decode) + (get-key :MSGID)) + msg-id)) + +(finalize)