56 lines
1.9 KiB
Common Lisp
56 lines
1.9 KiB
Common Lisp
(in-package #:live-chat-ws)
|
|
|
|
(defvar *connections* (make-hash-table))
|
|
|
|
(defun handle-post-message (message)
|
|
"Handle a new message being posted to the chat."
|
|
(let* ((message (gethash "message" (com.inuoe.jzon:parse message)))
|
|
(message (string-trim '(#\Newline #\Return)
|
|
(cl-who:escape-string message))))
|
|
(when (and message
|
|
(> (length message) 0)
|
|
(not (string= "" message)))
|
|
(format *standard-output* "Message received: ~a~%" message)
|
|
(live-chat-db:insert-message message))))
|
|
|
|
(defun handle-new-connection (con)
|
|
(setf (gethash con *connections*)
|
|
(princ-to-string (gensym "USER-"))))
|
|
|
|
(defun broadcast-to-room (connection message)
|
|
(let* ((message (handle-post-message message))
|
|
(message (live-chat-ui:generate-html-message
|
|
(format nil "~a: ~a"
|
|
(gethash connection *connections*)
|
|
message))))
|
|
(loop for con being the hash-key of *connections* do
|
|
(send con message))))
|
|
|
|
(defun handle-close-connection (connection)
|
|
(let ((message
|
|
(live-chat-ui:generate-html-message
|
|
(format nil "... ~a disconnected."
|
|
(gethash connection *connections*)))))
|
|
(loop for con being the hash-key of *connections* do
|
|
(send con message))))
|
|
|
|
(defun make-websocket-server (env)
|
|
(handler-case
|
|
(let ((ws (make-server env)))
|
|
(on :open ws
|
|
(lambda ()
|
|
(handle-new-connection ws)))
|
|
(on :message ws
|
|
(lambda (msg)
|
|
(broadcast-to-room ws msg)))
|
|
(on :close ws
|
|
(lambda (&key code reason)
|
|
(declare (ignore code reason))
|
|
(handle-close-connection ws)))
|
|
(lambda (responder)
|
|
(declare (ignore responder))
|
|
(start-connection ws)))
|
|
(error (e)
|
|
(declare (ignore e))
|
|
(format nil "Something went wrong. Try again?"))))
|