public
/
backplane-server
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Refactored to make testable. 

Added tests.
This commit is contained in:
Niten 2020-12-03 21:12:12 -08:00
parent f3a148f13c
commit 24e16f8ac4
4 changed files with 228 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
backplane-server.asd
View File

@ -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 <niten@fudo.org>"
: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)))

28
backplane-server.lisp
View File

@ -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)))))
(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)
(defun handle-xmpp-message (sender body)
(render-result
(handler-case
(success-> message
(xmpp:body)
(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")))))))
(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
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)

7
package.lisp
View File

@ -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))

185
test/backplane-server-test.lisp Normal file
View File

@ -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)