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