From 159301c234f1d3818cad386dfd8bb3970474c13f Mon Sep 17 00:00:00 2001
From: Niten <niten@fudo.org>
Date: Fri, 13 Nov 2020 15:22:37 -0800
Subject: [PATCH] switch to json working
---
backplane-dns.lisp | 12 +++++------
backplane-server.lisp | 48 ++++++++++++++++++++++++++++++++-----------
2 files changed, 42 insertions(+), 18 deletions(-)
diff --git a/backplane-dns.lisp b/backplane-dns.lisp
index 2cc9d4c..9326fd7 100644
--- a/backplane-dns.lisp
+++ b/backplane-dns.lisp
@@ -142,27 +142,27 @@
(defgeneric parse-dns-message (sender request message)
(:documentation "Parse a DNS service message of type REQUEST"))
-(defmethod parse-dns-message (sender (request (eql "change-ipv4")) message)
+(defmethod parse-dns-message (sender (request (eql :CHANGE_IPV4)) message)
(make-instance 'change-request-ipv4
:sender sender
:hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message))
- :ip-address (assoc :IP message)))
+ :ip-address (cdr (assoc :IP message))))
-(defmethod parse-dns-message (sender (request (eql "change-ipv6")) message)
+(defmethod parse-dns-message (sender (request (eql :CHANGE_IPV6)) message)
(make-instance 'change-request-ipv6
:sender sender
:hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message))
- :ip-address (assoc :IP message)))
+ :ip-address (cdr (assoc :IP message))))
(defmethod parse-dns-message (sender request message)
(make-instance 'unknown-request
:sender sender
:request request))
-(defmethod parse-message (sender (service (eql "dns")) api-version message)
- (parse-dns-message sender (cdr (assoc :REQUEST message)) message))
+(defmethod parse-message (sender (service (eql :DNS)) api-version message)
+ (parse-dns-message sender (symbolize (cdr (assoc :REQUEST message))) message))
(defun backplane-dns-listen (&key
xmpp-host
diff --git a/backplane-server.lisp b/backplane-server.lisp
index e0949f6..5af9b5a 100644
--- a/backplane-server.lisp
+++ b/backplane-server.lisp
@@ -19,6 +19,9 @@
(defclass result/success (result) ())
(defclass result/error (result) ())
+(defun error-p (obj) (typep obj (find-class 'result/error)))
+(defun success-p (obj) (typep obj (find-class 'result/success)))
+
(defun make-success (&optional msg)
(make-instance 'result/success :message msg))
@@ -43,16 +46,22 @@
(:documentation "Given an incoming message, turn it into the appropriate request."))
(defmethod parse-message (sender service api-version message)
- (make-error "unsupported request"))
+ (make-error (format nil "unsupported service: ~A" service)))
(defun decode-message (message-str)
- (cl-json:decode-json-from-string message-str))
+ (handler-case
+ (cl-json:decode-json-from-string message-str)
+ (json:json-syntax-error (err)
+ (declare (ignorable err))
+ (make-error (format nil "invalid json string: ~A" message-str)))))
+
+(defun symbolize (str) (-> str string-upcase (intern :KEYWORD)))
(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"))))
+ (if-let ((api-version (cdr (assoc :VERSION message)))
+ (service (symbolize (cdr (assoc :SERVICE message)))))
+ (parse-message sender service api-version (cdr (assoc :PAYLOAD message)))
+ (make-error (format nil "missing api_version or service name in request in message"))))
(defgeneric handle-message (message)
(:documentation "Perform necessary actions to handle a backplane message, and return a result."))
@@ -60,16 +69,31 @@
(defmethod handle-message ((message unknown-request))
(make-error (format nil "unknown request: ~A" (request message))))
+(defmacro success-> (init &rest forms)
+ (let ((blocksym (gensym)))
+ (flet ((maybe-call (f arg args)
+ `(let ((result ,arg))
+ (if (error-p result)
+ (return-from ,blocksym result)
+ (funcall (function ,f) result ,@args)))))
+ `(block ,blocksym
+ ,(reduce (lambda (acc next)
+ (if (listp next)
+ (maybe-call (car next) acc (cdr next))
+ (maybe-call next acc '())))
+ 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)
- (-> message
- (xmpp:body)
- (decode-message)
- (dispatch-parse-message sender)
- (handle-message)
- (render-result)))))
+ (render-result (success-> message
+ (xmpp:body)
+ (decode-message)
+ (dispatch-parse-message sender)
+ (handle-message))))))
(let ((backplane nil))
(defun backplane-connect (xmpp-host xmpp-username xmpp-password)