Refactored to make testable.

Added tests.

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

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)
+                  sender
-                  (render-result
+                  (handle-xmpp-message sender (xmpp:body message)))))
-                   (handler-case
+
-                       (success-> message
+(defun start-listening (backplane)
-                                  (xmpp:body)
+  (xmpp:receive-stanza-loop backplane))
-                                  (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")))))))
 
 (let ((backplane nil))
   (defun backplane-connect (xmpp-host xmpp-username xmpp-password)

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

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)