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

switch to json working

Browse Source
This commit is contained in:
Niten 2020-11-13 15:22:37 -08:00
parent c663acdd33
commit 159301c234
2 changed files with 42 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
backplane-dns.lisp
View File

@ -142,27 +142,27 @@
(defgeneric parse-dns-message (sender request message) (defgeneric parse-dns-message (sender request message)
(:documentation "Parse a DNS service message of type REQUEST")) (: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 (make-instance 'change-request-ipv4
:sender sender :sender sender
:hostname (sender-hostname sender) :hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message)) :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 (make-instance 'change-request-ipv6
:sender sender :sender sender
:hostname (sender-hostname sender) :hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message)) :domain (cdr (assoc :DOMAIN message))
:ip-address (assoc :IP message))) :ip-address (cdr (assoc :IP message))))
(defmethod parse-dns-message (sender request message) (defmethod parse-dns-message (sender request message)
(make-instance 'unknown-request (make-instance 'unknown-request
:sender sender :sender sender
:request request)) :request request))
(defmethod parse-message (sender (service (eql "dns")) api-version message) (defmethod parse-message (sender (service (eql :DNS)) api-version message)
(parse-dns-message sender (cdr (assoc :REQUEST message)) message)) (parse-dns-message sender (symbolize (cdr (assoc :REQUEST message))) message))
(defun backplane-dns-listen (&key (defun backplane-dns-listen (&key
xmpp-host xmpp-host

48
backplane-server.lisp
View File

@ -19,6 +19,9 @@
(defclass result/success (result) ()) (defclass result/success (result) ())
(defclass result/error (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) (defun make-success (&optional msg)
(make-instance 'result/success :message msg)) (make-instance 'result/success :message msg))
@ -43,16 +46,22 @@
(:documentation "Given an incoming message, turn it into the appropriate request.")) (:documentation "Given an incoming message, turn it into the appropriate request."))
(defmethod parse-message (sender service api-version message) (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) (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) (defun dispatch-parse-message (message sender)
(if-let ((api-version (cdr (assoc :API-VERSION message))) (if-let ((api-version (cdr (assoc :VERSION message)))
(service (cdr (assoc :SERVICE message)))) (service (symbolize (cdr (assoc :SERVICE message)))))
(parse-message sender service api-version (assoc :PAYLOAD message)) (parse-message sender service api-version (cdr (assoc :PAYLOAD message)))
(make-error (format nil "missing api-version or service name in request")))) (make-error (format nil "missing api_version or service name in request in message"))))
(defgeneric handle-message (message) (defgeneric handle-message (message)
(:documentation "Perform necessary actions to handle a backplane message, and return a result.")) (:documentation "Perform necessary actions to handle a backplane message, and return a result."))
@ -60,16 +69,31 @@
(defmethod handle-message ((message unknown-request)) (defmethod handle-message ((message unknown-request))
(make-error (format nil "unknown request: ~A" (request message)))) (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)) (defmethod xmpp:handle ((conn xmpp:connection) (message xmpp:message))
(let ((sender (xmpp:from message))) (let ((sender (xmpp:from message)))
(format *standard-output* "message received from ~A" sender)
(xmpp:message conn (xmpp:message conn
(xmpp:from message) (xmpp:from message)
(-> message (render-result (success-> message
(xmpp:body) (xmpp:body)
(decode-message) (decode-message)
(dispatch-parse-message sender) (dispatch-parse-message sender)
(handle-message) (handle-message))))))
(render-result)))))
(let ((backplane nil)) (let ((backplane nil))
(defun backplane-connect (xmpp-host xmpp-username xmpp-password) (defun backplane-connect (xmpp-host xmpp-username xmpp-password)