refactored, and switched to json payloads

2020-11-13 11:11:58 -08:00
parent 799c35d89f
commit c663acdd33
4 changed files with 114 additions and 78 deletions
@@ -0,0 +1,84 @@
+;;;; backplane-server.lisp
+
+(in-package #:backplane-dns)
+
+;; request
+
+(defclass request ()
+  ((sender :initarg :sender)))
+
+(defclass unknown-request (request)
+  ((request :initarg :request
+            :reader  request)))
+
+(defclass result ()
+  ((message :initarg :message)))
+
+;; result
+
+(defclass result/success (result) ())
+(defclass result/error   (result) ())
+
+(defun make-success (&optional msg)
+  (make-instance 'result/success :message msg))
+
+(defun make-error (&optional msg)
+  (make-instance 'result/error :message msg))
+
+(defgeneric render-result (result))
+
+(defmethod render-result ((res result/success))
+  (with-slots (message) res
+    (if message
+        (format nil "OK: ~A" message)
+        "OK")))
+
+(defmethod render-result ((res result/error))
+  (with-slots (message) res
+    (if message
+        (format nil "ERROR: ~A" message)
+        "ERROR")))
+
+(defgeneric parse-message (sender service api-version message)
+  (:documentation "Given an incoming message, turn it into the appropriate request."))
+
+(defmethod parse-message (sender service api-version message)
+  (make-error "unsupported request"))
+
+(defun decode-message (message-str)
+  (cl-json:decode-json-from-string message-str))
+
+(defun dispatch-parse-message (message sender)
+  (if-let ((api-version (cdr (assoc :API-VERSION message)))
+           (service     (cdr (assoc :SERVICE     message))))
+    (parse-message sender service api-version (assoc :PAYLOAD message))
+    (make-error (format nil "missing api-version or service name in request"))))
+
+(defgeneric handle-message (message)
+  (:documentation "Perform necessary actions to handle a backplane message, and return a result."))
+
+(defmethod handle-message ((message unknown-request))
+  (make-error (format nil "unknown request: ~A" (request message))))
+
+(defmethod xmpp:handle ((conn xmpp:connection) (message xmpp:message))
+  (let ((sender (xmpp:from message)))
+    (xmpp:message conn
+                  (xmpp:from message)
+                  (-> message
+                      (xmpp:body)
+                      (decode-message)
+                      (dispatch-parse-message sender)
+                      (handle-message)
+                      (render-result)))))
+
+(let ((backplane nil))
+  (defun backplane-connect (xmpp-host xmpp-username xmpp-password)
+    (if backplane
+        backplane
+        (progn (setf backplane (xmpp:connect-tls :hostname xmpp-host))
+               (xmpp:auth backplane
+                          xmpp-username
+                          xmpp-password
+                          (format nil "backplane-~A" (machine-instance))
+                          :mechanism :sasl-plain)
+               backplane))))