diff of e4a82c70084cb8ae465db1319e4c415c067b925b
e4a82c70084cb8ae465db1319e4c415c067b925b
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 7de9c6b..e238d0d 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -91,6 +91,8 @@
:perform (test-op (op c)
(eval (read-from-string "(fiveam:run! 'murja.tests:main-suite)"))))
+;; (ql:quickload :aggressive-murja)
+
;; (asdf:make "aggressive-murja")
;; (asdf:make "aggressive-murja/tests")
;; (murja:start-server)
diff --git a/resources/js/newui.js b/resources/js/newui.js
index 998d1c6..18991f5 100644
--- a/resources/js/newui.js
+++ b/resources/js/newui.js
@@ -1,4 +1,5 @@
let socket = null;
+let session_id = null;
window.addEventListener('DOMContentLoaded', _ => {
// TODO tää pitäisi varmaan jotenkin konffata
@@ -16,15 +17,24 @@ window.addEventListener('DOMContentLoaded', _ => {
// Listen for messages
socket.addEventListener("message", (event) => {
- let msg = JSON.parse(event.data);
+ let split = event.data.split(':');
+ let key = split[0];
+ switch(key) {
+ case "SESSIONID":
+ session_id = split[1];
+ break;
+ default:
+ let msg = JSON.parse(event.data);
- let id = msg.id;
- let html = msg["new-html"];
+ let id = msg.id;
+ let html = msg["new-html"];
- document.querySelector(`#${id}`).outerHTML = html;
+ document.querySelector(`#${id}`).outerHTML = html;
+ }
});
});
function send(event) {
- socket.send(`CALL ${event}`);
+ if(!session_id) { alert('Session id is damaged'); return; }
+ socket.send(`sessionid:${session_id};CALL:${event}`);
}
diff --git a/src/murja-newui/newui.lisp b/src/murja-newui/newui.lisp
index 9dc9d2e..73f6f33 100644
--- a/src/murja-newui/newui.lisp
+++ b/src/murja-newui/newui.lisp
@@ -8,11 +8,12 @@
;; pitäiskö nää olla uniikkeja per käyttäjä 🤔
(defclass ui-session (hunchensocket:websocket-resource)
- ((path :initarg :path :reader ui-path :initform "/newui")
+ ((path :initarg :path :reader ui-path :initform "/newui"))
(:default-initargs :client-class 'ui-user))
(defclass ui-user (hunchensocket:websocket-client)
- ((uid :initarg :uid :initform (uuid:make-v4-uuid) :reader uid)))
+ ((uid :initarg :uid :initform (uuid:make-v4-uuid) :reader uid)
+ (state :initarg :state :initform nil :reader state)))
(defvar handlers (list (make-instance 'ui-session)))
@@ -25,6 +26,7 @@
(pushnew 'find-handler hunchensocket:*websocket-dispatch-table*)
(defmethod hunchensocket:client-connected ((session ui-session) (user ui-user))
+ (hunchensocket:send-text-message user (format nil "SESSIONID:~a" (uid user)))
(format t "~a Connected!~%" (uid user)))
(defmethod hunchensocket:client-disconnected ((session ui-session) user)
@@ -34,13 +36,28 @@
;; (loop for peer in (hunchensocket:clients room)
;; do (hunchensocket:send-text-message peer (apply #'format nil message args))
+(defun get-msg-param (split-msg param)
+ (some (lambda (kv)
+ (let* ((split (str:split #\: kv)))
+ (and (string= (first split) param)
+ (second split))))
+ split-msg))
+
+
(defparameter *current-ws* nil)
(defmethod hunchensocket:text-message-received ((session ui-session) user message)
- (format t "~a said ~a~%" (uid user) message)
- (loop for peer in (hunchensocket:clients session)
- when (equalp (uid user) (uid peer))
- do (let ((*current-ws* peer))
- (call-event message))))
+ (let* ((split-msg (str:split #\; message))
+ (sessionid (get-msg-param split-msg "sessionid"))
+ (call-dst (get-msg-param split-msg "CALL")))
+
+
+
+ (format t "~a called ~a~%" (uid user) message)
+ (loop for peer in (hunchensocket:clients session)
+ when (and (equalp (uid user) (uid peer))
+ (equalp (prin1-to-string (uid peer)) sessionid))
+ do (let ((*current-ws* peer))
+ (call-event sessionid call-dst)))))
(defparameter *server* (make-instance 'hunchensocket:websocket-acceptor :port 3011))
;;(hunchentoot:stop *server*)
@@ -131,18 +148,23 @@
~a)" (alexandria:hash-table-plist (state-map s)) (root-component s)))
(defmacro with-state (bindings &rest body)
- (let ((rewritten-symbols (map 'list #'first bindings)))
+ (let* ((rewritten-symbols (map 'list #'first bindings))
+ (values (map 'list #'second bindings))
+ (_
+ (assert (equalp (length rewritten-symbols)
+ (length values))))
+ (actual-bindings-plist))
+ (declare (ignore _))
+ (dotimes (i (length rewritten-symbols))
+ (push (nth i values) actual-bindings-plist)
+ (push `(quote ,(nth i rewritten-symbols)) actual-bindings-plist))
+
+
(labels ((rewrite (element)
(cond ((listp element) (map 'list #'rewrite element))
((member element rewritten-symbols) `(get-state current-state (quote ,element)))
(t element))))
- `(let ((current-state (make-instance 'state :state ,(reduce (lambda (m pair)
- (destructuring-bind (k v &rest _) pair
- (declare (ignore _))
- (setf (gethash k m) v)
- m))
- bindings
- :initial-value (hash))))
+ `(let ((current-state (make-instance 'state :state (alexandria:plist-hash-table (list ,@actual-bindings-plist))))
(root-component-id (format nil "id~d" (random 123456))))
(setf (root-component current-state)
,@(rewrite body))
@@ -185,9 +207,9 @@
-(defun call-event (event)
- (let* ((id (second (str:split #\Space event)))
- (fn (gethash id *js-identifiers-in-scope*)))
+(defun call-event (sessionid call-dst)
+ (declare (ignore sessionid))
+ (let* ((fn (gethash call-dst *js-identifiers-in-scope*)))
(with-slots (closure) fn
(format t "Calling ~a~%" fn)
(funcall closure))))