From 5d003af92aff89cc600c1125e2e8767fc88b7ae4 Mon Sep 17 00:00:00 2001
From: LLLL Colonq <llll@colonq>
Date: Thu, 8 May 2025 04:31:17 -0400
Subject: The latest and greatest updates that you crave, now

---
 src/wasp-bus-binary.el            | 144 ++++++++++++++++++++++++++++++++++++++
 src/wasp-event-handlers-binary.el |  24 +++++++
 src/wasp-event-handlers.el        |   2 +-
 src/wasp-twitch.el                | 102 +++++++++++++--------------
 src/wasp-user-whitelist.el        |   2 +
 5 files changed, 222 insertions(+), 52 deletions(-)
 create mode 100644 src/wasp-bus-binary.el
 create mode 100644 src/wasp-event-handlers-binary.el

(limited to 'src')

diff --git a/src/wasp-bus-binary.el b/src/wasp-bus-binary.el
new file mode 100644
index 00000000..bb9fc6da
--- /dev/null
+++ b/src/wasp-bus-binary.el
@@ -0,0 +1,144 @@
+;;; wasp-bus-binary --- Pub/sub bus client -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'wasp-utils)
+
+(defcustom w/bus-binary-process "wasp-bus-binary"
+  "Name of process connected to binary message bus."
+  :type '(string)
+  :group 'wasp)
+
+(defcustom w/bus-binary-buffer " *wasp-bus-binary*"
+  "Name of buffer used to store intermediate binary message bus data."
+  :type '(string)
+  :group 'wasp)
+
+(defcustom w/bus-binary-host "shiro"
+  "Hostname of the binary message bus."
+  :type '(string)
+  :group 'wasp)
+
+(defcustom w/bus-binary-port 32051
+  "Port of the binary message bus."
+  :type '(integer)
+  :group 'wasp)
+
+(defvar w/bus-binary-event-handlers nil
+  "List of pairs of events and handler functions.")
+
+(defun w/bus-binary-read-bytes (len)
+  "Read LEN bytes from the current buffer.
+Advances point by LEN also."
+  (let ((end (+ (point) len)))
+    (when (<= end (point-max))
+      (let ((istr (buffer-substring (point) end)))
+        (forward-char len)
+        istr))))
+
+(defun w/bus-binary-read-int32le ()
+  "Read a 32-bit little endian integer from the current buffer."
+  (when-let* ((istr (w/bus-binary-read-bytes 4)))
+    (-let [(x0 x1 x2 x3) (seq-into istr 'list)]
+      (logior x0 (ash x1 8) (ash x2 16) (ash x3 24)))))
+
+(defun w/bus-binary-read-length-prefixed ()
+  "Read a length-prefixed string from the current buffer.
+Return nil if unable."
+  (let ((start (point)))
+    (if-let* ((len (w/bus-binary-read-int32le)))
+      (progn
+        (w/bus-binary-read-bytes len))
+      (goto-char start)
+      nil)))
+
+(defun w/bus-binary-read-message ()
+  "Parse a message from the current buffer.
+Return non-nil if a message was successfully parsed."
+  (if-let* ( (start (point))
+             (ev (w/bus-binary-read-length-prefixed))
+             (d (w/bus-binary-read-length-prefixed)))
+    (progn
+      (delete-region start (point))
+      (cons ev d))
+    (goto-char start)
+    nil))
+
+(defun w/bus-binary-handle-message ()
+  "Parse and handle a message from the current buffer.
+Return non-nil if a message was successfully parsed."
+  (when-let* ((msg (w/bus-binary-read-message)))
+    (-let [(ev . d) msg]
+      (print (cons ev d))
+      (when-let* ((handler (w/saget ev w/bus-binary-event-handlers)))
+        (funcall handler d))
+      t)))
+
+(defun w/bus-binary-process-filter (proc data)
+  "Process filter for binary message bus connection on PROC and DATA."
+  (with-current-buffer (get-buffer-create w/bus-binary-buffer)
+    (set-buffer-multibyte nil)
+    (when (not (marker-position (process-mark proc)))
+      (set-marker (process-mark proc) (point-max)))
+    (goto-char (process-mark proc))
+    (insert data)
+    (set-marker (process-mark proc) (point))
+    (goto-char (point-min))
+    (while (w/bus-binary-handle-message))))
+
+(defun w/bus-binary-build-int32le (x)
+  "Convert X into the bytes for a little endian 32-bit integer."
+  (unibyte-string
+    (logand x #xff)
+    (logand (lsh x -8) #xff)
+    (logand (lsh x -16) #xff)
+    (logand (lsh x -24) #xff)))
+
+(defun w/bus-binary-build-length-prefixed (s)
+  "Turn S into a length-prefixed unibyte string."
+  (s-concat
+    (w/bus-binary-build-int32le (string-bytes s))
+    s))
+
+(defun w/bus-binary-convert-event (ev)
+  "Convert the s-expression EV to a string event."
+  (s-chop-suffix ")" (s-chop-prefix "(" (format "%s" ev))))
+
+(defun w/binary-sub (ev)
+  "Subscribe to the event EV."
+  (process-send-string
+    w/bus-binary-process
+    (s-concat "s"
+      (w/bus-binary-build-length-prefixed (w/bus-binary-convert-event ev)))))
+
+(defun w/binary-pub (ev &optional d)
+  "Publish the data D to the event EV."
+  (process-send-string
+    w/bus-binary-process
+    (s-concat "p"
+      (w/bus-binary-build-length-prefixed (w/bus-binary-convert-event ev))
+      (w/bus-binary-build-length-prefixed (or d "")))))
+
+(defun w/bus-binary-disconnect ()
+  "Disconnect from Redis."
+  (when (process-live-p (get-process w/bus-binary-process))
+    (delete-process w/bus-binary-process)))
+
+(defun w/bus-binary-connect ()
+  "Connect to Redis."
+  (w/bus-binary-disconnect)
+  (with-current-buffer (get-buffer-create w/bus-binary-buffer)
+    (set-buffer-multibyte nil)
+    (erase-buffer))
+  (make-network-process
+   :coding 'no-conversion
+   :name w/bus-binary-process
+   :buffer nil
+   :host w/bus-binary-host
+   :service w/bus-binary-port
+   :filter #'w/bus-binary-process-filter))
+
+(provide 'wasp-bus-binary)
+;;; wasp-bus-binary.el ends here
diff --git a/src/wasp-event-handlers-binary.el b/src/wasp-event-handlers-binary.el
new file mode 100644
index 00000000..ae373b8c
--- /dev/null
+++ b/src/wasp-event-handlers-binary.el
@@ -0,0 +1,24 @@
+;;; wasp-event-handlers-binary --- Event handlers -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'wasp-utils)
+(require 'wasp-twitch)
+(require 'wasp-bus-binary)
+
+(setf
+  w/bus-binary-event-handlers
+  (list
+    (cons "monitor twitch chat incoming"
+      (lambda (d)
+        (-let [(user stags msg) (s-split-up-to " " d 2)]
+          (w/twitch-handle-incoming-chat
+            user
+            (--map (s-split "\t" it) (s-split "\n" stags))
+            msg)))))
+    ))
+
+(provide 'wasp-event-handlers-binary)
+;;; wasp-event-handlers-binary.el ends here
diff --git a/src/wasp-event-handlers.el b/src/wasp-event-handlers.el
index 0e5b8d46..d45debaf 100644
--- a/src/wasp-event-handlers.el
+++ b/src/wasp-event-handlers.el
@@ -39,7 +39,7 @@
           ((s-equals? (car msg) "won") (w/write-chat-event "Fufufu... I win..."))
           (t (w/write-chat-event "that it's over")))
         (setf w/overlay-barrage-active nil)))
-    (cons '(monitor twitch chat incoming) #'w/twitch-handle-incoming-chat)
+    (cons '(monitor twitch chat incoming) #'w/twitch-handle-incoming-chat-sexp)
     (cons '(monitor twitch redeem incoming) #'w/twitch-handle-redeem)
     (cons
       '(frontend redeem incoming)
diff --git a/src/wasp-twitch.el b/src/wasp-twitch.el
index 2ff66567..252ea8c2 100644
--- a/src/wasp-twitch.el
+++ b/src/wasp-twitch.el
@@ -538,48 +538,48 @@ CALLBACK will be passed the winner when the poll concludes."
        (when (-contains? badges "subscriber/0") "💻")
        (when (-contains? badges "founder/0") "🖥️"))))))
 
-(defun w/twitch-handle-incoming-chat (msg)
-  "Write MSG to the chat buffer, processing any commands."
-  ;; (w/write-log (format "%s" msg))
-  (let ((user (w/decode-string (car msg))))
-    (w/user-bind
-     user
-     (lambda ()
-       (let* ((tags (cadr msg))
-              (userid (car (w/saget "user-id" tags)))
+(defun w/twitch-handle-incoming-chat (user tags text)
+  "Write the message TEXT from USER with TAGS to the chat buffer.
+Process any commands included."
+  (w/user-bind
+    user
+    (lambda ()
+      (let* ( (userid (car (w/saget "user-id" tags)))
               (color (car (w/saget "color" tags)))
               (emotes (car (w/saget "emotes" tags)))
               (badges (s-split "," (car (w/saget "badges" tags))))
-              (text (w/decode-string (caddr msg)))
               (biblicality (w/bible-colorize-sentence text))
               (text-colored-bible (car biblicality))
               (text-with-emotes
-               (w/twitch-add-7tv-emotes
-                (w/twitch-process-emote-ranges
-                 (s-split "/" emotes)
-                 text-colored-bible))))
-         (push (cons user text) w/twitch-chat-history)
-
-         (w/user-stats-update)
-         (w/hexamedia-update-user user)
-         (w/shindaggers-update-user user)
-         (w/copfish-update-user user)
-         (when (s-equals? (s-downcase user) "modclonk")
-           (w/obs-activate-toggle 'modclonk))
-         (w/resolve-record-user user)
-         (w/hex-tick user)
-         (w/hex-transform
+                (w/twitch-add-7tv-emotes
+                  (w/twitch-process-emote-ranges
+                    (s-split "/" emotes)
+                    text-colored-bible))))
+        (push (cons user text) w/twitch-chat-history)
+        (w/user-stats-update)
+        (w/hexamedia-update-user user)
+        (w/shindaggers-update-user user)
+        (w/copfish-update-user user)
+        (when (s-equals? (s-downcase user) "modclonk")
+          (w/obs-activate-toggle 'modclonk))
+        (w/resolve-record-user user)
+        (w/hex-tick user)
+        (w/hex-transform
           user
           (w/make-chat-message
-           :user user
-           :id userid
-           :text text-with-emotes
-           :user-color (when (s-present? color) color)
-           :biblicality (cdr biblicality)
-           :sigil (w/twitch-badges-sigil badges)))
-         (--each w/twitch-chat-commands
-           (when (s-contains? (car it) text)
-             (funcall (cdr it) user text))))))))
+            :user user
+            :id userid
+            :text text-with-emotes
+            :user-color (when (s-present? color) color)
+            :biblicality (cdr biblicality)
+            :sigil (w/twitch-badges-sigil badges)))
+        (--each w/twitch-chat-commands
+          (when (s-contains? (car it) text)
+            (funcall (cdr it) user text)))))))
+
+(defun w/twitch-handle-incoming-chat-sexp (msg)
+  "Write MSG to the chat buffer, processing any commands."
+  (w/twitch-handle-incoming-chat (w/decode-string (car msg)) (cadr msg) (w/decode-string (caddr msg))))
 
 (defun w/twitch-handle-redeem-helper (user redeem input &optional limit)
   "Handle the channel point redeem REDEEM from USER with INPUT.
@@ -587,35 +587,35 @@ Optionally, only apply redeems with point costs less than LIMIT."
   (unless (-contains? w/user-hell (s-downcase user))
     (let ((handler (alist-get redeem w/twitch-redeems nil nil #'cl-equalp)))
       (if handler
-          (if (or (not limit) (< (car handler) limit))
-              (w/user-bind
-               user
-               (lambda ()
-                 (condition-case err
-                     (funcall (cadr handler) user input)
-                   (error
-                    (w/write-chat-event (format "Error during redeem: %s" err))))))
-            (w/write-chat-event (format "User %s attempted to activate overly expensive redeem \"%s\" via API" user redeem)))
+        (if (or (not limit) (< (car handler) limit))
+          (w/user-bind
+            user
+            (lambda ()
+              (condition-case err
+                (funcall (cadr handler) user input)
+                (error
+                  (w/write-chat-event (format "Error during redeem: %s" err))))))
+          (w/write-chat-event (format "User %s attempted to activate overly expensive redeem \"%s\" via API" user redeem)))
         (w/write-chat-event (format "Unknown channel point redeem: %S" redeem))))))
 
 (defun w/twitch-handle-redeem (r)
   "Handle the channel point redeem R."
   ;; (w/write-log r)
   (let* ((user (car r))
-         (redeem (cadr r))
-         (encoded-input (caddr r))
-         (input (when encoded-input (w/decode-string encoded-input))))
+          (redeem (cadr r))
+          (encoded-input (caddr r))
+          (input (when encoded-input (w/decode-string encoded-input))))
     (w/twitch-handle-redeem-helper user redeem input)))
 
 (defun w/twitch-handle-redeem-api (r)
   "Handle a channel point redeem R coming from the API."
   (w/write-log r)
   (let* ((encoded-user (car r))
-         (encoded-redeem (cadr r))
-         (encoded-input (caddr r))
-         (user (when encoded-user (w/decode-string encoded-user)))
-         (redeem (when encoded-redeem (w/decode-string encoded-redeem)))
-         (input (when encoded-input (w/decode-string encoded-input))))
+          (encoded-redeem (cadr r))
+          (encoded-input (caddr r))
+          (user (when encoded-user (w/decode-string encoded-user)))
+          (redeem (when encoded-redeem (w/decode-string encoded-redeem)))
+          (input (when encoded-input (w/decode-string encoded-input))))
     (w/twitch-handle-redeem-helper user redeem input 1000)))
 
 (provide 'wasp-twitch)
diff --git a/src/wasp-user-whitelist.el b/src/wasp-user-whitelist.el
index f23471d6..5f298b3d 100644
--- a/src/wasp-user-whitelist.el
+++ b/src/wasp-user-whitelist.el
@@ -240,6 +240,8 @@
       "taske666"
       "rat_not_like_noah"
       "RealNaesten"
+      "Wh4i3"
+      "kamszee"
       )))
 
 (setq
-- 
cgit v1.2.3