cl-chat-web/live-chat-ws.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?"))))