;;; kkkmeet-server.el --- Tiny WebRTC signaling server -*- lexical-binding: t; -*-

;; Run from a shell:
;;   emacs -Q --batch -l kkkmeet-server.el -f kkkmeet-server-run-batch
;;   CAPTCHA=secret emacs -Q --batch -l kkkmeet-server.el -f kkkmeet-server-run-batch
;;
;; Or from Emacs:
;;   M-x kkkmeet-server-start

(require 'cl-lib)
(require 'json)
(require 'seq)
(require 'subr-x)
(require 'url-util)

(defgroup kkkmeet-server nil
  "Small static file and WebRTC signaling server for kkkmeet."
  :group 'applications)

(defcustom kkkmeet-server-host "127.0.0.1"
  "Host address for `kkkmeet-server-start'."
  :type 'string)

(defcustom kkkmeet-server-port 3000
  "Port for `kkkmeet-server-start'."
  :type 'integer)

(defcustom kkkmeet-server-public-dir
  (expand-file-name "public" default-directory)
  "Directory containing the browser client."
  :type 'directory)

(defvar kkkmeet-server--process nil)
(defvar kkkmeet-server--rooms (make-hash-table :test 'equal))
(defvar kkkmeet-server--watch-states (make-hash-table :test 'equal))
(defvar kkkmeet-server--presentation-states (make-hash-table :test 'equal))
(defconst kkkmeet-server--default-room-id "main")

(defconst kkkmeet-server--mime-types
  '(("html" . "text/html; charset=utf-8")
    ("css" . "text/css; charset=utf-8")
    ("js" . "text/javascript; charset=utf-8")
    ("json" . "application/json; charset=utf-8")
    ("svg" . "image/svg+xml")))

(defconst kkkmeet-server--captcha-glyphs
  '(("a" . ("01110" "10001" "10001" "11111" "10001" "10001" "10001"))
    ("b" . ("11110" "10001" "10001" "11110" "10001" "10001" "11110"))
    ("c" . ("01111" "10000" "10000" "10000" "10000" "10000" "01111"))
    ("d" . ("11110" "10001" "10001" "10001" "10001" "10001" "11110"))
    ("e" . ("11111" "10000" "10000" "11110" "10000" "10000" "11111"))
    ("f" . ("11111" "10000" "10000" "11110" "10000" "10000" "10000"))
    ("g" . ("01111" "10000" "10000" "10111" "10001" "10001" "01111"))
    ("h" . ("10001" "10001" "10001" "11111" "10001" "10001" "10001"))
    ("i" . ("11111" "00100" "00100" "00100" "00100" "00100" "11111"))
    ("j" . ("00111" "00010" "00010" "00010" "10010" "10010" "01100"))
    ("k" . ("10001" "10010" "10100" "11000" "10100" "10010" "10001"))
    ("l" . ("10000" "10000" "10000" "10000" "10000" "10000" "11111"))
    ("m" . ("10001" "11011" "10101" "10101" "10001" "10001" "10001"))
    ("n" . ("10001" "11001" "10101" "10011" "10001" "10001" "10001"))
    ("o" . ("01110" "10001" "10001" "10001" "10001" "10001" "01110"))
    ("p" . ("11110" "10001" "10001" "11110" "10000" "10000" "10000"))
    ("q" . ("01110" "10001" "10001" "10001" "10101" "10010" "01101"))
    ("r" . ("11110" "10001" "10001" "11110" "10100" "10010" "10001"))
    ("s" . ("01111" "10000" "10000" "01110" "00001" "00001" "11110"))
    ("t" . ("11111" "00100" "00100" "00100" "00100" "00100" "00100"))
    ("u" . ("10001" "10001" "10001" "10001" "10001" "10001" "01110"))
    ("v" . ("10001" "10001" "10001" "10001" "10001" "01010" "00100"))
    ("w" . ("10001" "10001" "10001" "10101" "10101" "10101" "01010"))
    ("x" . ("10001" "10001" "01010" "00100" "01010" "10001" "10001"))
    ("y" . ("10001" "10001" "01010" "00100" "00100" "00100" "00100"))
    ("z" . ("11111" "00001" "00010" "00100" "01000" "10000" "11111"))
    ("0" . ("01110" "10001" "10011" "10101" "11001" "10001" "01110"))
    ("1" . ("00100" "01100" "00100" "00100" "00100" "00100" "01110"))
    ("2" . ("01110" "10001" "00001" "00010" "00100" "01000" "11111"))
    ("3" . ("11110" "00001" "00001" "01110" "00001" "00001" "11110"))
    ("4" . ("10010" "10010" "10010" "11111" "00010" "00010" "00010"))
    ("5" . ("11111" "10000" "10000" "11110" "00001" "00001" "11110"))
    ("6" . ("01111" "10000" "10000" "11110" "10001" "10001" "01110"))
    ("7" . ("11111" "00001" "00010" "00100" "01000" "01000" "01000"))
    ("8" . ("01110" "10001" "10001" "01110" "10001" "10001" "01110"))
    ("9" . ("01110" "10001" "10001" "01111" "00001" "00001" "11110"))
    ("-" . ("00000" "00000" "00000" "11111" "00000" "00000" "00000"))
    ("_" . ("00000" "00000" "00000" "00000" "00000" "00000" "11111"))))

(defun kkkmeet-server--uuid ()
  "Return a UUID-like random peer id."
  (let ((hex (md5 (format "%s-%s-%s" (current-time) (random) (emacs-pid)))))
    (format "%s-%s-%s-%s-%s"
            (substring hex 0 8)
            (substring hex 8 12)
            (substring hex 12 16)
            (substring hex 16 20)
            (substring hex 20 32))))

(defun kkkmeet-server--room (room-id)
  "Return room hash table for ROOM-ID, creating it when needed."
  (or (gethash room-id kkkmeet-server--rooms)
      (puthash room-id (make-hash-table :test 'equal) kkkmeet-server--rooms)))

(defun kkkmeet-server--room-peers (table)
  "Return peer objects from room TABLE."
  (let (peers)
    (maphash
     (lambda (peer-id process)
       (push `((id . ,peer-id)
               (name . ,(or (process-get process :kkkmeet-name) "Guest"))
               (clientId . ,(or (process-get process :kkkmeet-client-id) "")))
             peers))
     table)
    (vconcat (nreverse peers))))

(defun kkkmeet-server--normalize-name (name)
  "Return a display-safe NAME."
  (let ((normalized (string-trim (replace-regexp-in-string "[ \t\n\r]+" " " (or name "")))))
    (if (string-empty-p normalized)
        "Guest"
      (substring normalized 0 (min 48 (length normalized))))))

(defun kkkmeet-server--normalize-announcement (text)
  "Return a display-safe announcement TEXT."
  (let ((normalized (string-trim (replace-regexp-in-string "[ \t\n\r]+" " " (or text "")))))
    (substring normalized 0 (min 240 (length normalized)))))

(defun kkkmeet-server--clamp-number (value fallback min max)
  "Return VALUE clamped between MIN and MAX, or FALLBACK."
  (let ((number (if (numberp value) value fallback)))
    (min max (max min number))))

(defun kkkmeet-server--normalize-voice-settings (settings)
  "Return sanitized voice SETTINGS."
  (let ((safe-settings (if (listp settings) settings nil)))
    `((amplitude . ,(kkkmeet-server--clamp-number (alist-get 'amplitude safe-settings) 100 0 200))
      (pitch . ,(kkkmeet-server--clamp-number (alist-get 'pitch safe-settings) 32 0 99))
      (speed . ,(kkkmeet-server--clamp-number (alist-get 'speed safe-settings) 135 80 240))
      (wordgap . ,(kkkmeet-server--clamp-number (alist-get 'wordgap safe-settings) 4 0 20)))))

(defun kkkmeet-server--normalize-client-id (value)
  "Return a safe persistent client id from VALUE."
  (let ((normalized (string-trim (or value ""))))
    (if (string-match-p "\\`[A-Za-z0-9_-]\\{16,80\\}\\'" normalized)
        normalized
      "")))

(defun kkkmeet-server--captcha-passphrase ()
  "Return the configured join captcha passphrase."
  (or (getenv "CAPTCHA") "kkkmeet"))

(defun kkkmeet-server--captcha-accepted-p (value)
  "Return non-nil when VALUE matches the configured captcha passphrase."
  (equal (downcase (or value "")) (downcase (kkkmeet-server--captcha-passphrase))))

(defun kkkmeet-server--captcha-svg ()
  "Return an SVG captcha image for the configured passphrase."
  (let* ((cell 4)
         (gap 4)
         (padding 10)
         (passphrase (downcase (kkkmeet-server--captcha-passphrase)))
         (chars (append passphrase nil))
         (width (max 160 (- (+ (* 2 padding)
                               (* (length chars) (+ (* 5 cell) gap)))
                            gap)))
         (height 42)
         rects)
    (cl-loop for char in chars
             for index from 0
             for key = (char-to-string char)
             for glyph = (or (cdr (assoc key kkkmeet-server--captcha-glyphs))
                             (cdr (assoc "_" kkkmeet-server--captcha-glyphs)))
             do (cl-loop for row in glyph
                         for y from 0
                         do (cl-loop for pixel across row
                                     for x from 0
                                     when (eq pixel ?1)
                                     do (push
                                         (format
                                          "<rect x=\"%s\" y=\"%s\" width=\"%s\" height=\"%s\" rx=\"1\"/>"
                                          (+ padding (* index (+ (* 5 cell) gap)) (* x cell))
                                          (+ 7 (* y cell))
                                          (1- cell)
                                          (1- cell))
                                         rects))))
    (format "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"%s\" height=\"%s\" viewBox=\"0 0 %s %s\">
  <rect width=\"100%%\" height=\"100%%\" fill=\"#eef2f6\"/>
  <path d=\"M0 34 C35 2 78 44 %s 12\" stroke=\"rgba(24,32,42,0.22)\" stroke-width=\"1.5\" fill=\"none\"/>
  <g fill=\"#18202a\" transform=\"skewX(-4)\">%s</g>
</svg>"
            width height width height width (string-join (nreverse rects) ""))))

(defun kkkmeet-server--nonnegative-number (value)
  "Return VALUE as a nonnegative number, or zero."
  (max 0 (if (numberp value) value 0)))

(defun kkkmeet-server--normalize-playlist (playlist)
  "Return a sanitized YouTube PLAYLIST vector."
  (let ((seen (make-hash-table :test 'equal))
        items)
    (dolist (item (cond
                   ((vectorp playlist) (append playlist nil))
                   ((listp playlist) playlist)
                   (t nil)))
      (let* ((video-id (and (listp item) (alist-get 'videoId item)))
             (title (and (listp item) (alist-get 'title item)))
             (position (and (listp item) (alist-get 'position item)))
             (duration (and (listp item) (alist-get 'duration item)))
             (safe-video-id (and video-id (format "%s" video-id)))
             (safe-title (string-trim (format "%s" (or title "")))))
        (when (and safe-video-id
                   (string-match-p "\\`[A-Za-z0-9_-]\\{11\\}\\'" safe-video-id)
                   (not (gethash safe-video-id seen))
                   (< (length items) 50))
          (puthash safe-video-id t seen)
          (push `((videoId . ,safe-video-id)
                  (title . ,(if (string-empty-p safe-title)
                                (format "YouTube video %s" safe-video-id)
                              safe-title))
                  (position . ,(kkkmeet-server--nonnegative-number position))
                  (duration . ,(kkkmeet-server--nonnegative-number duration)))
                items))))
    (vconcat (nreverse items))))

(defun kkkmeet-server--json (value)
  "Encode VALUE as JSON."
  (let ((json-array-type 'list)
        (json-object-type 'alist)
        (json-false :false))
    (json-encode value)))

(defun kkkmeet-server--send-response (process status headers &optional body keep-open)
  "Send HTTP response to PROCESS with STATUS, HEADERS, and BODY.
When KEEP-OPEN is nil, close PROCESS after writing."
  (let* ((reason (pcase status
                   (200 "OK")
                   (202 "Accepted")
                   (400 "Bad Request")
                   (403 "Forbidden")
                   (404 "Not Found")
                   (405 "Method Not Allowed")
                   (_ "Internal Server Error")))
         (payload (or body ""))
         (base-headers `(("Connection" . ,(if keep-open "keep-alive" "close"))
                         ,@headers))
         (full-headers (if keep-open
                           base-headers
                         `(("Content-Length" . ,(number-to-string (string-bytes payload)))
                           ,@base-headers))))
    (process-send-string process (format "HTTP/1.1 %s %s\r\n" status reason))
    (dolist (header full-headers)
      (process-send-string process (format "%s: %s\r\n" (car header) (cdr header))))
    (process-send-string process "\r\n")
    (when body
      (process-send-string process payload))
    (unless keep-open
      (delete-process process))))

(defun kkkmeet-server--send-json (process status value)
  "Send JSON VALUE to PROCESS."
  (kkkmeet-server--send-response
   process status
   '(("Content-Type" . "application/json; charset=utf-8")
     ("Cache-Control" . "no-store"))
   (kkkmeet-server--json value)))

(defun kkkmeet-server--send-sse (process value)
  "Send VALUE as a server-sent event to PROCESS."
  (when (process-live-p process)
    (process-send-string process (format "data: %s\n\n" (kkkmeet-server--json value)))))

(defun kkkmeet-server--broadcast (room-id sender-id value)
  "Broadcast VALUE in ROOM-ID to everyone except SENDER-ID."
  (let ((room (gethash room-id kkkmeet-server--rooms)))
    (when room
      (maphash
       (lambda (peer-id process)
         (unless (equal peer-id sender-id)
           (kkkmeet-server--send-sse process value)))
       room))))

(defun kkkmeet-server--remove-peer (process)
  "Remove PROCESS from its room and notify remaining peers."
  (let ((room-id (process-get process :kkkmeet-room-id))
        (peer-id (process-get process :kkkmeet-peer-id))
        (name (or (process-get process :kkkmeet-name) "A participant")))
    (when (and room-id peer-id)
      (let ((room (gethash room-id kkkmeet-server--rooms)))
        (when room
          (remhash peer-id room)
          (kkkmeet-server--broadcast
           room-id peer-id `((type . "peer-left") (peerId . ,peer-id) (name . ,name)))
          (when (equal (alist-get 'peerId (gethash room-id kkkmeet-server--presentation-states))
                       peer-id)
            (remhash room-id kkkmeet-server--presentation-states)
            (kkkmeet-server--broadcast
             room-id peer-id `((type . "presentation-state")
                               (from . ,peer-id)
                               (name . ,name)
                               (sharing . :false))))
          (when (= (hash-table-count room) 0)
            (remhash room-id kkkmeet-server--rooms)
            (remhash room-id kkkmeet-server--presentation-states)))))))

(defun kkkmeet-server--parse-request (raw)
  "Parse RAW HTTP request into an alist."
  (let* ((split (string-match-p "\r\n\r\n" raw))
         (head (substring raw 0 split))
         (body (substring raw (+ split 4)))
         (lines (split-string head "\r\n"))
         (request-line (split-string (car lines) " "))
         (headers (make-hash-table :test 'equal)))
    (dolist (line (cdr lines))
      (when (string-match "\\`\\([^:]+\\):[ \t]*\\(.*\\)\\'" line)
        (puthash (downcase (match-string 1 line)) (match-string 2 line) headers)))
    `((method . ,(nth 0 request-line))
      (target . ,(nth 1 request-line))
      (path . ,(car (split-string (nth 1 request-line) "?")))
      (headers . ,headers)
      (body . ,body))))

(defun kkkmeet-server--request-complete-p (raw)
  "Return non-nil when RAW contains a complete HTTP request."
  (when-let ((split (string-match-p "\r\n\r\n" raw)))
    (let* ((head (substring raw 0 split))
           (headers (make-hash-table :test 'equal)))
      (dolist (line (cdr (split-string head "\r\n")))
        (when (string-match "\\`\\([^:]+\\):[ \t]*\\(.*\\)\\'" line)
          (puthash (downcase (match-string 1 line)) (match-string 2 line) headers)))
      (let ((length (string-to-number (or (gethash "content-length" headers) "0"))))
        (>= (string-bytes (substring raw (+ split 4))) length)))))

(defun kkkmeet-server--safe-static-path (url-path)
  "Return a safe static file path for URL-PATH, or nil."
  (let* ((relative (if (equal url-path "/") "/index.html" url-path))
         (decoded (url-unhex-string relative))
         (full-path (expand-file-name (string-remove-prefix "/" decoded)
                                      kkkmeet-server-public-dir))
         (root (file-name-as-directory (expand-file-name kkkmeet-server-public-dir))))
    (when (string-prefix-p root full-path)
      full-path)))

(defun kkkmeet-server--serve-static (process method path)
  "Serve static file PATH to PROCESS for METHOD."
  (let ((file-path (kkkmeet-server--safe-static-path path)))
    (cond
     ((not file-path)
      (kkkmeet-server--send-response process 403 nil "Forbidden"))
     ((not (file-regular-p file-path))
      (kkkmeet-server--send-response process 404 nil "Not found"))
     (t
      (let* ((extension (file-name-extension file-path))
             (mime (or (cdr (assoc extension kkkmeet-server--mime-types))
                       "application/octet-stream"))
             (body (unless (equal method "HEAD")
                     (with-temp-buffer
                       (set-buffer-multibyte nil)
                       (insert-file-contents-literally file-path)
                       (buffer-string)))))
        (kkkmeet-server--send-response
         process 200
         `(("Content-Type" . ,mime)
           ("Cache-Control" . "no-store"))
         body))))))

(defun kkkmeet-server--query-param (target name)
  "Return query parameter NAME from request TARGET."
  (when-let ((query (cadr (split-string target "?" t))))
    (cadr (assoc name (url-parse-query-string query)))))

(defun kkkmeet-server--handle-captcha (process method)
  "Send the captcha image to PROCESS."
  (kkkmeet-server--send-response
   process 200
   '(("Content-Type" . "image/svg+xml; charset=utf-8")
     ("Cache-Control" . "no-store"))
   (unless (equal method "HEAD")
     (kkkmeet-server--captcha-svg))))

(defun kkkmeet-server--handle-captcha-verify (process answer)
  "Send captcha verification result for ANSWER to PROCESS."
  (kkkmeet-server--send-json
   process 200 `((ok . ,(if (kkkmeet-server--captcha-accepted-p answer) t :false)))))

(defun kkkmeet-server--handle-events (process room-id display-name client-id captcha)
  "Attach PROCESS to ROOM-ID as an SSE client."
  (if (not (kkkmeet-server--captcha-accepted-p captcha))
      (kkkmeet-server--send-json process 403 '((error . "Captcha passphrase is required.")))
    (let* ((safe-room-id (if (string-empty-p room-id) kkkmeet-server--default-room-id room-id))
           (room (kkkmeet-server--room safe-room-id))
           (peer-id (kkkmeet-server--uuid))
           (peers (kkkmeet-server--room-peers room))
           (safe-name (kkkmeet-server--normalize-name display-name))
           (safe-client-id (kkkmeet-server--normalize-client-id client-id)))
      (process-put process :kkkmeet-room-id safe-room-id)
      (process-put process :kkkmeet-peer-id peer-id)
      (process-put process :kkkmeet-name safe-name)
      (process-put process :kkkmeet-client-id safe-client-id)
      (puthash peer-id process room)
      (kkkmeet-server--send-response
       process 200
       '(("Content-Type" . "text/event-stream; charset=utf-8")
         ("Cache-Control" . "no-store, no-transform")
         ("X-Accel-Buffering" . "no"))
       nil t)
      (kkkmeet-server--send-sse
       process `((type . "welcome")
                 (peerId . ,peer-id)
                 (name . ,safe-name)
                 (clientId . ,safe-client-id)
                 (peers . ,peers)
                 (watchState . ,(or (gethash safe-room-id kkkmeet-server--watch-states)
                                    nil))
                 (presentationState . ,(or (gethash safe-room-id kkkmeet-server--presentation-states)
                                           nil))))
      (kkkmeet-server--broadcast
       safe-room-id peer-id `((type . "peer-joined")
                              (peerId . ,peer-id)
                              (name . ,safe-name)
                              (clientId . ,safe-client-id))))))

(defun kkkmeet-server--handle-signal (process room-id body)
  "Handle signaling BODY from PROCESS for ROOM-ID."
  (condition-case error
      (let* ((json-object-type 'alist)
             (payload (json-read-from-string body))
             (from (alist-get 'from payload))
             (to (alist-get 'to payload))
             (type (alist-get 'type payload))
             (target (gethash to (gethash room-id kkkmeet-server--rooms))))
        (if (and from to type)
            (progn
              (when target
                (kkkmeet-server--send-sse target payload))
              (kkkmeet-server--send-json process 202 '((ok . t))))
          (kkkmeet-server--send-json
           process 400 '((error . "Signal messages require from, to, and type.")))))
    (error
     (kkkmeet-server--send-json process 400 `((error . ,(error-message-string error)))))))

(defun kkkmeet-server--handle-watch (process room-id body)
  "Handle shared YouTube watch state BODY for ROOM-ID."
  (condition-case error
      (let* ((json-object-type 'alist)
             (payload (json-read-from-string body))
             (from (alist-get 'from payload))
             (type (alist-get 'type payload))
             (video-id (format "%s" (or (alist-get 'videoId payload) "")))
             (action (format "%s" (or (alist-get 'action payload) "")))
             (playlist (kkkmeet-server--normalize-playlist (alist-get 'playlist payload)))
             (safe-room-id (if (string-empty-p room-id)
                               kkkmeet-server--default-room-id
                             room-id)))
        (if (and from (equal type "watch-state"))
            (let* ((active-video-id (if (seq-some
                                         (lambda (item)
                                           (equal video-id (alist-get 'videoId item)))
                                        (append playlist nil))
                                        video-id
                                      ""))
                   (safe-action (if (and (equal action "play")
                                         (not (string-empty-p active-video-id)))
                                    "play"
                                  "pause"))
                   (watch-state `((type . "watch-state")
                                  (from . ,from)
                                  (name . ,(kkkmeet-server--normalize-name
                                            (alist-get 'name payload)))
                                  (videoId . ,active-video-id)
                                  (playlist . ,playlist)
                                  (position . ,(or (alist-get 'position payload) 0))
                                  (playing . ,(if (equal safe-action "play") t :false))
                                  (action . ,safe-action)
                                  (updatedAt . ,(or (alist-get 'updatedAt payload)
                                                    (floor (* 1000 (float-time))))))))
              (puthash safe-room-id watch-state kkkmeet-server--watch-states)
              (kkkmeet-server--broadcast safe-room-id from watch-state)
              (kkkmeet-server--send-json process 202 '((ok . t))))
          (kkkmeet-server--send-json
           process 400 '((error . "Watch messages require from and type=watch-state.")))))
    (error
     (kkkmeet-server--send-json process 400 `((error . ,(error-message-string error)))))))

(defun kkkmeet-server--handle-room-event (process room-id body)
  "Handle shared room event BODY for ROOM-ID."
  (condition-case error
      (let* ((json-object-type 'alist)
             (payload (json-read-from-string body))
             (from (alist-get 'from payload))
             (type (alist-get 'type payload))
             (safe-room-id (if (string-empty-p room-id)
                               kkkmeet-server--default-room-id
                             room-id)))
        (cond
         ((and from (equal type "presentation-state"))
          (let ((event `((type . "presentation-state")
                         (from . ,from)
                         (peerId . ,from)
                         (name . ,(kkkmeet-server--normalize-name
                                   (alist-get 'name payload)))
                         (sharing . ,(if (alist-get 'sharing payload) t :false))
                         (updatedAt . ,(floor (* 1000 (float-time)))))))
            (if (alist-get 'sharing payload)
                (let ((previous (gethash safe-room-id kkkmeet-server--presentation-states)))
                  (when (and previous
                             (alist-get 'peerId previous)
                             (not (equal (alist-get 'peerId previous) from)))
                    (kkkmeet-server--broadcast
                     safe-room-id from `((type . "presentation-state")
                                         (from . ,(alist-get 'peerId previous))
                                         (peerId . ,(alist-get 'peerId previous))
                                         (name . ,(alist-get 'name previous))
                                         (sharing . :false)
                                         (reason . "takeover")
                                         (replacedBy . ,from)
                                         (replacedByName . ,(alist-get 'name event))
                                         (updatedAt . ,(floor (* 1000 (float-time)))))))
                  (puthash safe-room-id event kkkmeet-server--presentation-states))
              (when (equal (alist-get 'peerId (gethash safe-room-id kkkmeet-server--presentation-states))
                           from)
                (remhash safe-room-id kkkmeet-server--presentation-states)))
            (kkkmeet-server--broadcast safe-room-id from event)
            (kkkmeet-server--send-json process 202 '((ok . t)))))
         ((and from (equal type "voice-announcement"))
          (let ((text (kkkmeet-server--normalize-announcement
                       (alist-get 'text payload))))
            (if (string-empty-p text)
                (kkkmeet-server--send-json
                 process 400 '((error . "Voice announcements require text.")))
              (let ((event `((type . "voice-announcement")
                             (from . ,from)
                             (name . ,(kkkmeet-server--normalize-name
                                       (alist-get 'name payload)))
                             (text . ,text)
                             (voice . ,(kkkmeet-server--normalize-voice-settings
                                        (alist-get 'voice payload)))
                             (updatedAt . ,(floor (* 1000 (float-time)))))))
                (kkkmeet-server--broadcast safe-room-id from event)
                (kkkmeet-server--send-json process 202 '((ok . t)))))))
         (t
          (kkkmeet-server--send-json
           process 400 '((error . "Room events require from and a supported type."))))))
    (error
     (kkkmeet-server--send-json process 400 `((error . ,(error-message-string error)))))))

(defun kkkmeet-server--handle-request (process request)
  "Route REQUEST for PROCESS."
  (let ((method (alist-get 'method request))
        (target (alist-get 'target request))
        (path (alist-get 'path request))
        (body (alist-get 'body request)))
    (cond
     ((and (member method '("GET" "HEAD")) (equal path "/captcha.svg"))
      (kkkmeet-server--handle-captcha process method))
     ((and (equal method "GET") (equal path "/captcha/verify"))
      (kkkmeet-server--handle-captcha-verify
       process (kkkmeet-server--query-param target "answer")))
     ((and (equal method "GET") (string-prefix-p "/events/" path))
      (kkkmeet-server--handle-events
       process
       (url-unhex-string (string-remove-prefix "/events/" path))
       (kkkmeet-server--query-param target "name")
       (kkkmeet-server--query-param target "clientId")
       (kkkmeet-server--query-param target "captcha")))
     ((and (equal method "POST") (string-prefix-p "/signal/" path))
      (kkkmeet-server--handle-signal
       process (url-unhex-string (string-remove-prefix "/signal/" path)) body))
     ((and (equal method "POST") (string-prefix-p "/watch/" path))
      (kkkmeet-server--handle-watch
       process (url-unhex-string (string-remove-prefix "/watch/" path)) body))
     ((and (equal method "POST") (string-prefix-p "/room-event/" path))
      (kkkmeet-server--handle-room-event
       process (url-unhex-string (string-remove-prefix "/room-event/" path)) body))
     ((member method '("GET" "HEAD"))
      (kkkmeet-server--serve-static process method path))
     (t
      (kkkmeet-server--send-response process 405 nil "Method not allowed")))))

(defun kkkmeet-server--filter (process chunk)
  "Accumulate request CHUNK for PROCESS and respond when complete."
  (let ((raw (concat (or (process-get process :kkkmeet-raw-request) "") chunk)))
    (process-put process :kkkmeet-raw-request raw)
    (when (kkkmeet-server--request-complete-p raw)
      (process-put process :kkkmeet-raw-request nil)
      (condition-case error
          (kkkmeet-server--handle-request process (kkkmeet-server--parse-request raw))
        (error
         (kkkmeet-server--send-json process 500 `((error . ,(error-message-string error)))))))))

(defun kkkmeet-server--sentinel (process _event)
  "Clean up PROCESS when a connection closes."
  (unless (process-live-p process)
    (kkkmeet-server--remove-peer process)))

;;;###autoload
(defun kkkmeet-server-start (&optional port host)
  "Start kkkmeet server on PORT and HOST."
  (interactive)
  (kkkmeet-server-stop)
  (setq kkkmeet-server--rooms (make-hash-table :test 'equal))
  (setq kkkmeet-server--watch-states (make-hash-table :test 'equal))
  (setq kkkmeet-server--presentation-states (make-hash-table :test 'equal))
  (setq kkkmeet-server--process
        (make-network-process
         :name "kkkmeet-server"
         :server t
         :host (or host kkkmeet-server-host)
         :service (or port kkkmeet-server-port)
         :coding 'binary
         :filter #'kkkmeet-server--filter
         :sentinel #'kkkmeet-server--sentinel))
  (message "kkkmeet is running at http://%s:%s"
           (or host kkkmeet-server-host)
           (or port kkkmeet-server-port)))

;;;###autoload
(defun kkkmeet-server-stop ()
  "Stop the kkkmeet server and all active SSE clients."
  (interactive)
  (when (process-live-p kkkmeet-server--process)
    (delete-process kkkmeet-server--process))
  (maphash
   (lambda (_room-id room)
     (maphash (lambda (_peer-id process)
                (when (process-live-p process)
                  (delete-process process)))
              room))
   kkkmeet-server--rooms)
  (setq kkkmeet-server--process nil)
  (setq kkkmeet-server--rooms (make-hash-table :test 'equal))
  (setq kkkmeet-server--watch-states (make-hash-table :test 'equal))
  (setq kkkmeet-server--presentation-states (make-hash-table :test 'equal)))

;;;###autoload
(defun kkkmeet-server-run-batch ()
  "Run kkkmeet server forever for `emacs --batch'."
  (let ((port (or (and (getenv "PORT") (string-to-number (getenv "PORT")))
                  kkkmeet-server-port))
        (host (or (getenv "HOST") kkkmeet-server-host)))
    (kkkmeet-server-start port host)
    (while t
      (accept-process-output nil 1))))

(provide 'kkkmeet-server)
;;; kkkmeet-server.el ends here