From 2a54fc3e0d113dc05ee1c5bf5b3391690fc4164c Mon Sep 17 00:00:00 2001
From: Bubblegumdrop <staticsunn@gmail.com>
Date: Fri, 11 Oct 2024 16:45:22 -0400
Subject: [PATCH] Initial commit for git.lain.church

---
 .gitignore                 |  4 +++
 live-chat-cgi.lisp         | 32 +++++++++++++++++++++
 live-chat-core.lisp        | 70 ++++++++++++++++++++++++++++++++++++++++++++++
 live-chat-db.lisp          | 50 +++++++++++++++++++++++++++++++++
 live-chat-hunchentoot.lisp | 43 ++++++++++++++++++++++++++++
 live-chat-main.lisp        |  5 ++++
 live-chat.asd              | 21 ++++++++++++++
 makefile                   | 22 +++++++++++++++
 package.lisp               | 47 +++++++++++++++++++++++++++++++
 readme.org                 |  3 ++
 10 files changed, 297 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 live-chat-cgi.lisp
 create mode 100644 live-chat-core.lisp
 create mode 100644 live-chat-db.lisp
 create mode 100644 live-chat-hunchentoot.lisp
 create mode 100644 live-chat-main.lisp
 create mode 100644 live-chat.asd
 create mode 100644 makefile
 create mode 100644 package.lisp
 create mode 100644 readme.org

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..c983b6a
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,4 @@
+bin/
+*.bin
+*.fasl
+*.db
diff --git a/live-chat-cgi.lisp b/live-chat-cgi.lisp
new file mode 100644
index 0000000..3a7b8db
--- /dev/null
+++ b/live-chat-cgi.lisp
@@ -0,0 +1,32 @@
+(in-package #:live-chat-cgi)
+
+(defun print-http-header ()
+  "Print standard HTTP headers for CGI."
+  (format t "Content-Type: text/html~%~%"))
+
+(defun cgi-handler ()
+  "Handle CGI requests and dispatch them to the appropriate logic."
+  (let ((request-method (string-downcase (or (getenv "REQUEST_METHOD") ""))))
+    (print-http-header)
+    (cond
+      ((string= request-method "get")
+       (let ((path (getenv "PATH_INFO")))
+         (cond
+           ((string= path "/chat-messages")
+            (render-chat-messages))
+           ((string= path "/")
+            (render-chat-ui))
+           (t
+            (format t "Not Found")))))
+      ((string= request-method "post")
+       ;; Read the POST data
+       (let ((input (read-line *standard-input*)))
+         (when (and input (not (string= input "")))
+           (let ((params (split-sequence:split-sequence #\& input)))
+             (dolist (param params)
+               (let* ((pair (split-sequence:split-sequence #\= param))
+                      (key (first pair))
+                      (value (second pair)))
+                 (when (string= key "message")
+                   (handle-post-message value))))))
+         (render-chat-messages))))))
diff --git a/live-chat-core.lisp b/live-chat-core.lisp
new file mode 100644
index 0000000..d3a8d0d
--- /dev/null
+++ b/live-chat-core.lisp
@@ -0,0 +1,70 @@
+(in-package #:cl-user)
+
+(in-package #:live-chat-core)
+
+;; (defvar *messages* (make-array 0 :adjustable t :fill-pointer t)
+;;   "Array to store chat messages.")
+
+(defun handle-post-message (message)
+  "Handle a new message being posted to the chat."
+  (insert-message message)
+  ;; (vector-push-extend message *messages*)
+  (format nil "Message received: ~a" message))
+
+(defun render-chat-messages ()
+  "Render the list of chat messages as HTML."
+  (let ((messages (fetch-messages)))
+    (if messages
+        (cl-who:with-html-output-to-string (*standard-output* nil :indent t)
+          (:h3 :class "title is-3" "Chat Messages")
+          (loop for msg in messages
+                do (cl-who:htm
+                    (:div :class "box" (cl-who:str msg)))))
+        "")))
+
+(defun render-chat-ui ()
+  "Render the main chat page with HTMX integration."
+  (cl-who:with-html-output-to-string (*standard-output* nil :prologue t :indent t)
+    (:html :lang "en"
+           (:head
+            (:meta :charset "utf-8")
+            (:meta :name "viewport" :content "width=device-width, initial-scale=1")
+            (:title "Live Chat")
+            (:link :rel "stylesheet"
+                   :href "https://cdnjs.cloudflare.com/ajax/libs/bulma/1.0.2/css/bulma.min.css"
+                   :integrity "sha512-RpeJZX3aH5oZN3U3JhE7Sd+HG8XQsqmP3clIbu4G28p668yNsRNj3zMASKe1ATjl/W80wuEtCx2dFA8xaebG5w=="
+                   :crossorigin "anonymous"
+                   :referrerpolicy "no-referrer")
+            (:script :src "https://cdnjs.cloudflare.com/ajax/libs/htmx/2.0.3/htmx.min.js"
+                     :integrity "sha512-dQu3OKLMpRu85mW24LA1CUZG67BgLPR8Px3mcxmpdyijgl1UpCM1RtJoQP6h8UkufSnaHVRTUx98EQT9fcKohw=="
+                     :crossorigin "anonymous"
+                     :referrerpolicy "no-referrer"))
+           (:body
+            (:section :class "section"
+                      (:div :class "container"
+                            (:h1 :class "title" "Live Chat")
+
+                            ;; Form for sending messages
+                            (:form :id "post-message-form"
+                                   :name "post-message-form"
+                                   :hx-post "/post-message"
+                                   :hx-swap "innerHTML"
+                                   :hx-target "#chat-messages"
+                                   (:div :class "field has-addons"
+                                         (:div :class "control is-expanded"
+                                               (:input :class "input is-expanded"
+                                                       :form "post-message-form"
+                                                       :placeholder "Ender your message..."
+                                                       :type "text" :name "message"))
+                                         (:div :class "control"
+                                               (:button :class "button is-link is-light"
+                                                        :form "post-message-form"
+                                                        :type "submit" "Send"))))))
+
+            ;; Chat messages will be updated by HTMX via GET to /chat-messages
+            (:section :class "section"
+                      (:div :class "container"
+                            :id "chat-messages"
+                            :hx-get "/chat-messages"
+                            :hx-trigger "every 2s"
+                            (cl-who:str (render-chat-messages))))))))
diff --git a/live-chat-db.lisp b/live-chat-db.lisp
new file mode 100644
index 0000000..6600328
--- /dev/null
+++ b/live-chat-db.lisp
@@ -0,0 +1,50 @@
+(in-package #:live-chat-db)
+
+(defvar *db* nil
+  "Database connection object.")
+
+(defun open-database ()
+  "Open the SQLite database."
+  (setf *db* (dbi:connect-cached
+              :sqlite3 :database-name
+              (asdf:system-relative-pathname :live-chat "chat.db"))))
+
+(defun close-database ()
+  "Close the SQLite database."
+  (when *db* (dbi:disconnect *db*)))
+
+(defun create-messages-table ()
+  "Create the messages table if it doesn't exist."
+  (open-database)
+  (let ((query (dbi:prepare *db*
+                            "CREATE TABLE IF NOT EXISTS messages
+(id INTEGER PRIMARY KEY AUTOINCREMENT,
+ content TEXT NOT NULL)")))
+    (dbi:execute query (list)))
+  (close-database))
+
+(defun insert-message (message)
+  "Insert a new message into the database."
+  (open-database)
+  (let ((query (dbi:prepare *db*
+                            "INSERT INTO messages (content) VALUES (?)")))
+    (dbi:execute query (list message))
+    (close-database)
+    message))
+
+(defun fetch-messages ()
+  "Fetch all messages from the database."
+  (open-database)
+  (let* ((query (dbi:prepare *db*
+                             "SELECT content FROM messages ORDER BY id"))
+         (query (dbi:execute query (list)))
+         (results (loop for row = (dbi:fetch query)
+                        while row
+                        collect (getf row :|content|))))
+    (close-database)
+    (reverse results)))
+
+(defun clear-messages ()
+  "Clear all messages from the database."
+  (let ((query (dbi:prepare *db* "DELETE FROM messages")))
+    (dbi:execute query (list))))
diff --git a/live-chat-hunchentoot.lisp b/live-chat-hunchentoot.lisp
new file mode 100644
index 0000000..2c47a02
--- /dev/null
+++ b/live-chat-hunchentoot.lisp
@@ -0,0 +1,43 @@
+(in-package #:live-chat-hunchentoot)
+
+(defvar *server* nil
+  "The server acceptor.")
+
+(hunchentoot:define-easy-handler (chat-index :uri "/") ()
+  "Handle GET requests to / and render the chat UI."
+  (render-chat-ui))
+
+(hunchentoot:define-easy-handler (chat-handler :uri "/chat-messages") ()
+  "Handle GET requests to /chat-messages and render the chat UI."
+  (render-chat-messages))
+
+(hunchentoot:define-easy-handler (chat-post-handler :uri "/post-message" :default-request-type :post) ()
+  "Handle POST requests to /post-message and process the message."
+  (let ((message (hunchentoot:post-parameter "message")))
+    (when (and message (not (string= message "")))
+      (handle-post-message message)))
+  (render-chat-messages))
+
+(defun start-chat-server (&optional (address "localhost") (port 8080))
+  "Start the Hunchentoot chat server."
+  (setf (cl-who:html-mode) :html5
+        *server* (make-instance 'hunchentoot:easy-acceptor
+                                :address address
+                                :port port))
+  (hunchentoot:start *server*)
+  (format t "Chat server started on port 8080~%")
+  (wait-for-hunchentoot-listener "hunchentoot-listener-"))
+
+;; https://stackoverflow.com/a/30424968
+(defun wait-for-hunchentoot-listener (name)
+  (bt2:join-thread
+   (find-if
+    (lambda (th)
+      (prefixp name (bt2:thread-name th)))
+    (bt2:all-threads))))
+
+;; https://github.com/brown/base?tab=readme-ov-file#prefixp-prefix-sequence-key-test-eql
+(defun prefixp (prefix sequence &key (test #'eql))
+  "Does PREFIX match a prefix of SEQUENCE?"
+  (let ((mismatch (mismatch prefix sequence :test test)))
+    (or (null mismatch) (= mismatch (length prefix)))))
diff --git a/live-chat-main.lisp b/live-chat-main.lisp
new file mode 100644
index 0000000..b34fc53
--- /dev/null
+++ b/live-chat-main.lisp
@@ -0,0 +1,5 @@
+(in-package #:live-chat)
+
+(defun main ()
+  (create-messages-table)
+  (start-chat-server))
diff --git a/live-chat.asd b/live-chat.asd
new file mode 100644
index 0000000..e75f597
--- /dev/null
+++ b/live-chat.asd
@@ -0,0 +1,21 @@
+;;;; live-chat.asd
+
+(asdf:defsystem #:live-chat
+  :description "Twitch.TV-like live chat on the web. Uses HTMX to poll for messages."
+  :author "Bubblegumdrop <staticsunn@gmail.com>"
+  :license  "WTFPL 2+"
+  :version "0.1.0"
+  :defsystem-depends-on (:deploy)  ;; so you need to quickload deploy sometime before.
+  :build-operation "deploy-op"  ;; instead of program-op for asdf:make
+  :build-pathname "live-chat"
+  :entry-point "live-chat::main"
+  :depends-on (#:bordeaux-threads
+               #:cl-dbi
+               #:cl-who
+               #:hunchentoot)
+  :components ((:file "package")
+               (:file "live-chat-db")
+               (:file "live-chat-core")
+               (:file "live-chat-hunchentoot")
+               (:file "live-chat-cgi")
+               (:file "live-chat-main")))
diff --git a/makefile b/makefile
new file mode 100644
index 0000000..f5e5642
--- /dev/null
+++ b/makefile
@@ -0,0 +1,22 @@
+PROG := live-chat
+
+SRC := $(wildcard *.asd) $(wildcard *.lisp)
+BIN := $(PROG).bin
+
+all: install
+
+install: $(BIN)
+
+bin/$(PROG): $(SRC)
+	sbcl --load $< \
+	    --eval "(load \"live-chat.asd\")" \
+	    --eval "(asdf:load-system :live-chat)" \
+	    --eval "(asdf:make 'live-chat)"
+
+$(BIN): bin/$(PROG)
+	mv $< $@
+
+clean:
+	$(RM) -rf *~ bin $(BIN)
+
+.PHONY: all install
diff --git a/package.lisp b/package.lisp
new file mode 100644
index 0000000..656a526
--- /dev/null
+++ b/package.lisp
@@ -0,0 +1,47 @@
+(in-package #:cl-user)
+
+(defpackage #:live-chat-db
+  (:use #:cl)
+  (:local-nicknames (#:cl-dbi #:dbi))
+  (:export #:*db*
+           #:open-database
+           #:close-database
+           #:create-messages-table
+           #:insert-message
+           #:fetch-messages))
+
+(defpackage #:live-chat-core
+  (:use #:cl)
+  (:local-nicknames (#:cl-who #:cl-who))
+  (:import-from #:live-chat-db
+                #:insert-message
+                #:fetch-messages)
+  (:export #:render-chat-messages
+           #:render-chat-ui
+           #:handle-post-message
+           #:*messages*))
+
+(defpackage #:live-chat-cgi
+  (:use #:cl)
+  (:import-from #:live-chat-core)
+  (:export #:cgi-handler))
+
+(defpackage #:live-chat-hunchentoot
+  (:use #:cl)
+  (:import-from #:live-chat-core
+                #:handle-post-message
+                #:render-chat-messages
+                #:render-chat-ui)
+  (:local-nicknames (#:cl-who #:cl-who)
+                    (#:hunchentoot #:hunchentoot))
+  (:export #:start-chat-server))
+
+(uiop:define-package #:live-chat
+  (:use #:cl)
+  (:use-reexport #:live-chat-core
+                 #:live-chat-cgi
+                 #:live-chat-db
+                 #:live-chat-hunchentoot))
+
+(in-package #:live-chat)
+
diff --git a/readme.org b/readme.org
new file mode 100644
index 0000000..eb6a3b1
--- /dev/null
+++ b/readme.org
@@ -0,0 +1,3 @@
+* What It Is
+
+Twitch.TV-like live chat on the web. Uses HTMX to poll for messages. No database support (yet).