init codebase

This commit is contained in:
2026-02-17 17:30:45 -05:00
parent a3b28549b4
commit f7e2755a91
175 changed files with 21600 additions and 232 deletions
+12
View File
@@ -0,0 +1,12 @@
FROM clojure:temurin-21-tools-deps AS builder
WORKDIR /app
COPY deps.edn build.clj ./
COPY shared/ shared/
COPY web-sm/ web-sm/
RUN clj -T:build uber :module web-sm
FROM eclipse-temurin:21-jre-alpine
WORKDIR /app
COPY --from=builder /app/web-sm/target/web-sm.jar app.jar
EXPOSE 3002
CMD ["java", "-jar", "app.jar"]
+14
View File
@@ -0,0 +1,14 @@
{:server {:host "0.0.0.0" :port 3002}
:api {:base-url "http://localhost:3001"}
:nats {:url "nats://localhost:4222"
:stream-name "ajet-events"}
:assets {:tailwind-cdn true
:datastar-cdn true}
:session {:max-connections 10000}
:ui {:messages-per-page 50
:typing-timeout-sec 15
:toast-duration-sec 5}
:profiles
{:test {:nats {:url "nats://localhost:4223"}}
:prod {:assets {:tailwind-cdn false :datastar-cdn false}}}}
+568
View File
@@ -0,0 +1,568 @@
(ns ajet.chat.web.components
"Hiccup UI components for the chat interface.
All components return Hiccup data structures (vectors).
Components are used both in full page renders (layout.clj)
and as SSE fragments (sse.clj).
Color palette: Catppuccin Mocha dark theme."
(:require [hiccup2.core :as h]
[ajet.chat.shared.markdown :as markdown]
[ajet.chat.shared.mentions :as mentions]
[clojure.string :as str]))
(declare channel-item dm-item)
;;; ---------------------------------------------------------------------------
;;; Helpers
;;; ---------------------------------------------------------------------------
(defn- format-timestamp
"Format an ISO timestamp or inst for display."
[ts]
(when ts
(let [s (str ts)]
(if (> (count s) 16)
(subs s 11 16)
s))))
(defn- user-initials
"Get initials from a display name or username."
[name-str]
(when name-str
(let [parts (str/split (str/trim name-str) #"\s+")]
(str/upper-case
(apply str (map #(first %) (take 2 parts)))))))
(defn- avatar-color
"Deterministic color from a string (for initials avatars)."
[id-str]
(let [colors ["#89b4fa" "#a6e3a1" "#f38ba8" "#fab387" "#cba6f7"
"#f9e2af" "#94e2d5" "#74c7ec" "#f5c2e7" "#b4befe"]
idx (mod (Math/abs (.hashCode (str id-str))) (count colors))]
(nth colors idx)))
(defn- community-initial
"Get display initial(s) for a community."
[community]
(let [n (:name community "?")]
(str/upper-case (subs n 0 (min 2 (count n))))))
;;; ---------------------------------------------------------------------------
;;; Community Strip (Pane 1)
;;; ---------------------------------------------------------------------------
(defn community-strip
"Vertical strip of community icons, similar to Discord's server list."
[{:keys [communities active-id unread-count]}]
(list
;; Home / DMs button
[:div {:class "w-12 h-12 rounded-2xl bg-surface0 flex items-center justify-center
cursor-pointer hover:rounded-xl hover:bg-blue transition-all duration-200 mb-2 relative"
:data-on-click "@post('/web/navigate', {headers: {'X-Target': 'dms'}})"}
[:svg {:class "w-6 h-6 text-text" :viewBox "0 0 24 24" :fill "currentColor"}
[:path {:d "M12 2C6.48 2 2 6.48 2 12s4.48 10 10 10 10-4.48 10-10S17.52 2 12 2zm0 3c1.66 0 3 1.34 3 3s-1.34 3-3 3-3-1.34-3-3 1.34-3 3-3zm0 14.2c-2.5 0-4.71-1.28-6-3.22.03-1.99 4-3.08 6-3.08 1.99 0 5.97 1.09 6 3.08-1.29 1.94-3.5 3.22-6 3.22z"}]]
(when (and unread-count (pos? unread-count))
[:span {:id "notification-badge"
:class "absolute -top-1 -right-1 bg-red text-base text-xs font-bold rounded-full w-5 h-5 flex items-center justify-center"}
(if (> unread-count 99) "99+" (str unread-count))])]
;; Separator
[:div {:class "w-8 h-0.5 bg-surface1 rounded-full mb-2"}]
;; Community icons
(for [comm communities]
(let [cid (str (:id comm))
active (= cid active-id)]
[:div {:key cid
:class (str "w-12 h-12 rounded-2xl flex items-center justify-center cursor-pointer "
"transition-all duration-200 text-sm font-bold "
(if active
"rounded-xl bg-blue text-base"
"bg-surface0 text-subtext0 hover:rounded-xl hover:bg-blue hover:text-base"))
:title (:name comm)
:data-on-click (str "@post('/web/navigate', {headers: {'X-Community-Id': '" cid "'}})")}
(community-initial comm)]))
;; Add community button
[:div {:class "w-12 h-12 rounded-2xl bg-surface0 flex items-center justify-center
cursor-pointer hover:rounded-xl hover:bg-green transition-all duration-200 mt-2"
:title "Create Community"
:data-on-click "window.location.href='/setup'"}
[:span {:class "text-green text-2xl font-light"} "+"]]))
;;; ---------------------------------------------------------------------------
;;; Sidebar (Pane 2)
;;; ---------------------------------------------------------------------------
(defn sidebar
"Channel list with categories and user info at bottom."
[{:keys [community channels channel categories user]}]
(let [active-channel-id (when channel (str (:id channel)))
categorized (group-by :category-id channels)
uncategorized (get categorized nil [])
sorted-categories (sort-by :position categories)]
(list
;; Community name header
[:div {:class "h-12 px-4 flex items-center border-b border-surface1 flex-shrink-0"}
[:h2 {:class "font-semibold text-text truncate text-sm"}
(or (:name community) "ajet chat")]
[:button {:class "ml-auto text-overlay0 hover:text-text"
:title "Community Settings"}
[:svg {:class "w-4 h-4" :viewBox "0 0 24 24" :fill "none" :stroke "currentColor" :stroke-width "2"}
[:circle {:cx "12" :cy "12" :r "3"}]
[:path {:d "M19.4 15a1.65 1.65 0 00.33 1.82l.06.06a2 2 0 010 2.83 2 2 0 01-2.83 0l-.06-.06a1.65 1.65 0 00-1.82-.33 1.65 1.65 0 00-1 1.51V21a2 2 0 01-4 0v-.09A1.65 1.65 0 009 19.4a1.65 1.65 0 00-1.82.33l-.06.06a2 2 0 01-2.83-2.83l.06-.06A1.65 1.65 0 004.68 15a1.65 1.65 0 00-1.51-1H3a2 2 0 010-4h.09A1.65 1.65 0 004.6 9a1.65 1.65 0 00-.33-1.82l-.06-.06a2 2 0 012.83-2.83l.06.06A1.65 1.65 0 009 4.68a1.65 1.65 0 001-1.51V3a2 2 0 014 0v.09a1.65 1.65 0 001 1.51 1.65 1.65 0 001.82-.33l.06-.06a2 2 0 012.83 2.83l-.06.06A1.65 1.65 0 0019.4 9a1.65 1.65 0 001.51 1H21a2 2 0 010 4h-.09a1.65 1.65 0 00-1.51 1z"}]]]]
;; Channel list
[:div {:id "channel-list" :class "flex-1 overflow-y-auto px-2 py-2"}
;; Uncategorized channels
(when (seq uncategorized)
(for [ch uncategorized]
(channel-item ch active-channel-id)))
;; Categorized channels
(for [cat sorted-categories]
(let [cat-channels (get categorized (str (:id cat)) [])]
(when (seq cat-channels)
[:div {:key (str (:id cat)) :class "mb-2"}
[:div {:class "flex items-center px-1 py-1 text-xs font-semibold text-overlay0 uppercase tracking-wide cursor-pointer hover:text-subtext0"}
[:svg {:class "w-3 h-3 mr-1" :viewBox "0 0 24 24" :fill "currentColor"}
[:path {:d "M7 10l5 5 5-5z"}]]
(:name cat)]
(for [ch cat-channels]
(channel-item ch active-channel-id))])))]
;; User info bar at bottom
[:div {:id "user-bar"
:class "h-14 px-3 flex items-center bg-mantle border-t border-surface1 flex-shrink-0"}
[:div {:class "w-8 h-8 rounded-full flex items-center justify-center text-xs font-bold flex-shrink-0"
:style (str "background-color: " (avatar-color (:id user)))}
(user-initials (or (:display-name user) (:username user)))]
[:div {:class "ml-2 min-w-0"}
[:div {:class "text-sm font-medium text-text truncate"}
(or (:display-name user) (:username user))]
[:div {:class "text-xs text-overlay0 truncate"}
(or (:status-text user) "Online")]]])))
(defn dm-sidebar
"DM list sidebar — shown when the Home/DM icon is active in the community strip."
[{:keys [dms active-dm user]}]
(let [active-dm-id (when active-dm (str (:id active-dm)))]
(list
;; Header
[:div {:class "h-12 px-4 flex items-center border-b border-surface1 flex-shrink-0"}
[:h2 {:class "font-semibold text-text truncate text-sm"} "Direct Messages"]
[:button {:class "ml-auto text-overlay0 hover:text-text"
:title "New DM"}
[:svg {:class "w-5 h-5" :viewBox "0 0 24 24" :fill "none" :stroke "currentColor" :stroke-width "2"}
[:path {:d "M12 20h9M16.5 3.5a2.121 2.121 0 013 3L7 19l-4 1 1-4L16.5 3.5z"}]]]]
;; DM list
[:div {:id "dm-list" :class "flex-1 overflow-y-auto px-2 py-2"}
(if (seq dms)
(for [dm dms]
(dm-item dm active-dm-id))
[:div {:class "text-sm text-overlay0 text-center py-8"}
"No conversations yet"])]
;; User info bar at bottom
[:div {:id "user-bar"
:class "h-14 px-3 flex items-center bg-mantle border-t border-surface1 flex-shrink-0"}
[:div {:class "w-8 h-8 rounded-full flex items-center justify-center text-xs font-bold flex-shrink-0"
:style (str "background-color: " (avatar-color (:id user)))}
(user-initials (or (:display-name user) (:username user)))]
[:div {:class "ml-2 min-w-0"}
[:div {:class "text-sm font-medium text-text truncate"}
(or (:display-name user) (:username user))]
[:div {:class "text-xs text-overlay0 truncate"}
(or (:status-text user) "Online")]]])))
(defn- channel-item
"Single channel entry in the sidebar."
[ch active-channel-id]
(let [cid (str (:id ch))
active (= cid active-channel-id)
ch-type (or (:type ch) "text")
prefix (if (= ch-type "voice") "\uD83D\uDD0A" "#")]
[:div {:key cid
:id (str "sidebar-channel-" cid)
:class (str "flex items-center px-2 py-1 rounded cursor-pointer text-sm "
(if active
"bg-surface0 text-text"
"text-overlay1 hover:text-subtext1 hover:bg-hover"))
:data-on-click (str "@post('/web/navigate', {headers: {'X-Channel-Id': '" cid "'}})")}
[:span {:class "mr-1.5 text-overlay0 text-xs"} prefix]
[:span {:class "truncate"} (:name ch)]
;; Unread badge placeholder
[:span {:id (str "unread-badge-" cid)
:class "ml-auto hidden bg-red text-base text-xs font-bold rounded-full px-1.5 min-w-[1.25rem] text-center"}]]))
(defn- dm-item
"Single DM entry in the sidebar."
[dm active-channel-id]
(let [dm-id (str (:id dm))
active (= dm-id active-channel-id)
name (or (:display-name dm) (:name dm) "Direct Message")]
[:div {:key dm-id
:id (str "sidebar-dm-" dm-id)
:class (str "flex items-center px-2 py-1 rounded cursor-pointer text-sm "
(if active
"bg-surface0 text-text"
"text-overlay1 hover:text-subtext1 hover:bg-hover"))
:data-on-click (str "@post('/web/navigate', {headers: {'X-Channel-Id': '" dm-id "'}})")}
[:div {:class "w-6 h-6 rounded-full flex items-center justify-center text-xs font-bold mr-2 flex-shrink-0"
:style (str "background-color: " (avatar-color dm-id))}
(user-initials name)]
[:span {:class "truncate"} name]
;; Online status dot
[:span {:id (str "presence-" dm-id)
:class "ml-auto w-2 h-2 rounded-full bg-green hidden"}]]))
;;; ---------------------------------------------------------------------------
;;; Channel Header
;;; ---------------------------------------------------------------------------
(defn channel-header
"Header bar above the message list showing channel name, topic, and actions."
[channel]
(let [ch-name (or (:name channel) "general")
topic (:topic channel)]
[:div {:class "h-12 px-4 flex items-center border-b border-surface1 flex-shrink-0"}
[:span {:class "text-overlay0 mr-1"} "#"]
[:span {:class "font-semibold text-text"} ch-name]
(when topic
[:span {:class "ml-3 text-sm text-overlay0 truncate"} topic])
[:div {:class "ml-auto flex items-center gap-3"}
;; Search button
[:button {:class "text-overlay0 hover:text-text"
:title "Search"
:data-on-click "$searchOpen = !$searchOpen"}
[:svg {:class "w-5 h-5" :viewBox "0 0 24 24" :fill "none" :stroke "currentColor" :stroke-width "2"}
[:circle {:cx "11" :cy "11" :r "8"}]
[:line {:x1 "21" :y1 "21" :x2 "16.65" :y2 "16.65"}]]]
;; Members / settings
[:button {:class "text-overlay0 hover:text-text"
:title "Channel Settings"}
[:svg {:class "w-5 h-5" :viewBox "0 0 24 24" :fill "none" :stroke "currentColor" :stroke-width "2"}
[:path {:d "M17 21v-2a4 4 0 00-4-4H5a4 4 0 00-4-4v2"}]
[:circle {:cx "9" :cy "7" :r "4"}]
[:path {:d "M23 21v-2a4 4 0 00-3-3.87M16 3.13a4 4 0 010 7.75"}]]]]]))
;;; ---------------------------------------------------------------------------
;;; Messages
;;; ---------------------------------------------------------------------------
(defn message-component
"Single message with avatar, username, timestamp, rendered markdown body,
reactions, and thread indicator."
[msg current-user]
(let [msg-id (str (:id msg))
user-id (str (:user-id msg))
username (or (:display-name msg) (:username msg) "unknown")
timestamp (format-timestamp (or (:created-at msg) (:created_at msg)))
body (:body-md msg (:body_md msg ""))
edited (or (:edited-at msg) (:edited_at msg))
reactions (or (:reactions msg) [])
thread-count (:thread-count msg (:thread_count msg 0))
is-own (= user-id (str (:id current-user)))
;; Render markdown to HTML, resolving mentions with a simple fallback
rendered-body (-> body
(mentions/render (fn [type id]
(case type
:user (or (:username (get (:mentions-cache msg) id)) id)
:channel (or (:name (get (:channels-cache msg) id)) id)
nil)))
markdown/->html)]
[:div {:id (str "msg-" msg-id)
:class "group flex px-4 py-1 hover:bg-hover rounded transition-colors relative"
:data-msg-id msg-id}
;; Avatar
[:div {:class "w-10 h-10 rounded-full flex-shrink-0 mr-3 flex items-center justify-center text-sm font-bold mt-0.5"
:style (str "background-color: " (avatar-color user-id))}
(user-initials username)]
;; Content
[:div {:class "flex-1 min-w-0"}
;; Name + timestamp row
[:div {:class "flex items-baseline gap-2"}
[:span {:class "font-medium text-sm text-text"} username]
[:span {:class "text-xs text-overlay0"} timestamp]
(when edited
[:span {:class "text-xs text-overlay0 italic"} "(edited)"])]
;; Body
[:div {:class "text-sm text-subtext1 mt-0.5 break-words message-body"}
(h/raw rendered-body)]
;; Attachments
(when-let [attachments (seq (:attachments msg))]
[:div {:class "mt-2 flex flex-wrap gap-2"}
(for [att attachments]
[:img {:key (str (:id att))
:src (or (:url att) (:storage-key att))
:alt (:filename att)
:class "max-w-xs max-h-60 rounded-lg border border-surface1"}])])
;; Reactions bar
(when (seq reactions)
[:div {:id (str "reactions-" msg-id)
:class "flex flex-wrap gap-1 mt-1"}
(for [r reactions]
[:button {:key (str (:emoji r) "-" (count (:users r)))
:class "flex items-center gap-1 px-2 py-0.5 rounded-full text-xs bg-surface0 border border-surface1 hover:border-blue transition-colors"
:data-on-click (str "@post('/web/reactions', {headers: {'X-Message-Id': '" msg-id "', 'X-Emoji': '" (:emoji r) "'}})")}
[:span (:emoji r)]
[:span {:class "text-subtext0"} (count (:users r))]])])
;; Thread indicator
(when (and thread-count (pos? thread-count))
[:button {:class "flex items-center gap-1 text-xs text-blue hover:underline mt-1"
:data-on-click (str "$threadOpen = true; $threadMessageId = '" msg-id "'")}
[:span (str thread-count " " (if (= 1 thread-count) "reply" "replies"))]])]
;; Hover action toolbar
[:div {:class "absolute right-2 -top-3 hidden group-hover:flex bg-surface0 rounded border border-surface1 shadow-lg"}
;; Add reaction
[:button {:class "p-1.5 hover:bg-hover rounded-l text-overlay0 hover:text-text"
:title "Add Reaction"
:data-on-click (str "$emojiOpen = !$emojiOpen; $threadMessageId = '" msg-id "'")}
"\uD83D\uDE00"]
;; Reply in thread
[:button {:class "p-1.5 hover:bg-hover text-overlay0 hover:text-text"
:title "Reply in Thread"
:data-on-click (str "$threadOpen = true; $threadMessageId = '" msg-id "'")}
"\uD83D\uDCAC"]
;; Edit (own messages only)
(when is-own
[:button {:class "p-1.5 hover:bg-hover text-overlay0 hover:text-text"
:title "Edit"
:data-on-click (str "let el = document.querySelector('#msg-" msg-id " .message-body');"
"el.contentEditable = 'true'; el.focus();")}
"\u270F\uFE0F"])
;; Delete (own messages only)
(when is-own
[:button {:class "p-1.5 hover:bg-hover rounded-r text-overlay0 hover:text-red"
:title "Delete"
:data-on-click (str "if(confirm('Delete this message?')) @post('/web/messages/" msg-id "/delete')")}
"\uD83D\uDDD1\uFE0F"])]]))
(defn message-list
"Scrollable list of messages with a 'Load older' trigger at top."
[messages current-user]
(list
;; Load older sentinel
[:div {:id "load-older-sentinel" :class "flex justify-center py-2"}
[:button {:class "text-xs text-overlay0 hover:text-subtext0 px-3 py-1 rounded bg-surface0 hover:bg-hover transition-colors"
:data-on-click "@post('/web/messages', {headers: {'X-Load-Older': 'true'}})"}
"Load older messages"]]
;; Messages
[:div {:id "messages-container"}
(for [msg messages]
(message-component msg current-user))]
;; Typing indicator
[:div {:id "typing-indicator" :class "px-4 py-1 text-xs text-overlay0 h-6"}]))
;;; ---------------------------------------------------------------------------
;;; Message Input
;;; ---------------------------------------------------------------------------
(defn message-input
"Message composition area with textarea and send button."
[channel]
(let [channel-id (when channel (str (:id channel)))
ch-name (or (:name channel) "general")]
[:div {:class "bg-surface0 rounded-lg border border-surface1"}
[:div {:class "flex items-end"}
;; Upload button
[:button {:class "p-3 text-overlay0 hover:text-text flex-shrink-0"
:title "Upload Image"
:data-on-click "document.getElementById('file-upload-input').click()"}
[:svg {:class "w-5 h-5" :viewBox "0 0 24 24" :fill "none" :stroke "currentColor" :stroke-width "2"}
[:path {:d "M21.44 11.05l-9.19 9.19a6 6 0 01-8.49-8.49l9.19-9.19a4 4 0 015.66 5.66l-9.2 9.19a2 2 0 01-2.83-2.83l8.49-8.48"}]]]
;; Hidden file input
[:input {:type "file"
:id "file-upload-input"
:class "hidden"
:accept "image/jpeg,image/png,image/gif,image/webp"
:data-on-change (str "@post('/web/upload', {headers: {'X-Channel-Id': '" (or channel-id "") "'}})")}]
;; Textarea
[:textarea {:id "message-textarea"
:class "flex-1 bg-transparent text-text placeholder-overlay0 px-1 py-3 resize-none outline-none text-sm max-h-40"
:placeholder (str "Message #" ch-name)
:rows "1"
:data-bind "messageText"
:data-on-keydown (str "if(evt.key === 'Enter' && !evt.shiftKey) {"
" evt.preventDefault();"
" if($messageText.trim()) {"
" @post('/web/messages', {headers: {'X-Channel-Id': '" (or channel-id "") "'}});"
" }"
"}")
:data-on-input (str "@post('/web/typing', {headers: {'X-Channel-Id': '" (or channel-id "") "'}})")}]
;; Send button
[:button {:class "p-3 text-blue hover:text-text flex-shrink-0"
:title "Send"
:data-on-click (str "if($messageText.trim()) {"
" @post('/web/messages', {headers: {'X-Channel-Id': '" (or channel-id "") "'}});"
"}")}
[:svg {:class "w-5 h-5" :viewBox "0 0 24 24" :fill "currentColor"}
[:path {:d "M2.01 21L23 12 2.01 3 2 10l15 2-15 2z"}]]]]]))
;;; ---------------------------------------------------------------------------
;;; Thread Panel
;;; ---------------------------------------------------------------------------
(defn thread-panel
"Thread view with root message and replies."
[root-msg replies current-user]
[:div {:class "flex flex-col h-full"}
;; Thread header
[:div {:class "h-12 px-4 flex items-center border-b border-surface1 flex-shrink-0"}
[:span {:class "font-semibold text-text text-sm"} "Thread"]
[:button {:class "ml-auto text-overlay0 hover:text-text"
:data-on-click "$threadOpen = false"}
[:svg {:class "w-5 h-5" :viewBox "0 0 24 24" :fill "none" :stroke "currentColor" :stroke-width "2"}
[:line {:x1 "18" :y1 "6" :x2 "6" :y2 "18"}]
[:line {:x1 "6" :y1 "6" :x2 "18" :y2 "18"}]]]]
;; Root message
(when root-msg
[:div {:class "border-b border-surface1 px-2 py-2"}
(message-component root-msg current-user)])
;; Replies
[:div {:class "flex-1 overflow-y-auto px-2 py-2"}
(for [reply replies]
(message-component reply current-user))]
;; Thread reply input
[:div {:class "px-3 pb-3"}
[:div {:class "bg-surface0 rounded-lg border border-surface1 flex items-end"}
[:textarea {:class "flex-1 bg-transparent text-text placeholder-overlay0 px-3 py-2 resize-none outline-none text-sm max-h-24"
:placeholder "Reply in thread..."
:rows "1"
:data-bind "threadReply"
:data-signals-thread-reply ""
:data-on-keydown (str "if(evt.key === 'Enter' && !evt.shiftKey) {"
" evt.preventDefault();"
" if($threadReply.trim()) {"
" @post('/web/messages', {headers: {'X-Parent-Id': $threadMessageId}});"
" }"
"}")}]
[:button {:class "p-2 text-blue hover:text-text flex-shrink-0"
:data-on-click (str "if($threadReply.trim()) {"
" @post('/web/messages', {headers: {'X-Parent-Id': $threadMessageId}});"
"}")}
[:svg {:class "w-4 h-4" :viewBox "0 0 24 24" :fill "currentColor"}
[:path {:d "M2.01 21L23 12 2.01 3 2 10l15 2-15 2z"}]]]]]])
;;; ---------------------------------------------------------------------------
;;; Notification Toast
;;; ---------------------------------------------------------------------------
(defn notification-toast
"Toast popup for notifications."
[{:keys [id title body type]}]
(let [color (case type
:mention "#f38ba8"
:dm "#89b4fa"
:thread "#cba6f7"
"#89b4fa")]
[:div {:id (str "toast-" (or id (random-uuid)))
:class "toast-enter bg-surface0 border border-surface1 rounded-lg shadow-xl p-3 max-w-sm min-w-[280px]"
:style (str "border-left: 3px solid " color)
:data-on-click "this.remove()"}
[:div {:class "flex items-start gap-2"}
[:div {:class "flex-1 min-w-0"}
[:div {:class "text-sm font-medium text-text truncate"} (or title "Notification")]
[:div {:class "text-xs text-subtext0 mt-0.5 truncate"} (or body "")]]
[:button {:class "text-overlay0 hover:text-text flex-shrink-0 text-sm"
:data-on-click "this.parentElement.parentElement.remove()"}
"\u2715"]]]))
;;; ---------------------------------------------------------------------------
;;; Emoji Picker
;;; ---------------------------------------------------------------------------
(def ^:private emoji-grid
"Common emoji organized for quick picking."
["\uD83D\uDE04" "\uD83D\uDE02" "\uD83D\uDE0D" "\uD83E\uDD14" "\uD83D\uDC4D"
"\uD83D\uDC4E" "\u2764\uFE0F" "\uD83D\uDD25" "\uD83D\uDE80" "\uD83C\uDF89"
"\uD83D\uDCAF" "\u2705" "\u274C" "\uD83D\uDC40" "\uD83D\uDC4B"
"\uD83D\uDCAA" "\uD83D\uDE4F" "\uD83D\uDC4F" "\u2728" "\u2B50"
"\uD83D\uDE09" "\uD83D\uDE0E" "\uD83D\uDE2D" "\uD83D\uDCA9" "\uD83C\uDF7A"
"\u2615" "\uD83C\uDF55" "\uD83D\uDC1B" "\uD83D\uDD27" "\uD83D\uDCA1"])
(defn emoji-picker
"Server-rendered emoji grid for adding reactions."
[]
[:div {:class "bg-surface0 border border-surface1 rounded-lg shadow-xl p-3 w-72"}
[:div {:class "text-xs font-semibold text-overlay0 uppercase mb-2"} "Pick an Emoji"]
[:div {:class "grid grid-cols-6 gap-1"}
(for [emoji emoji-grid]
[:button {:key emoji
:class "emoji-btn text-xl w-10 h-10 flex items-center justify-center rounded hover:bg-hover"
:data-on-click (str "@post('/web/reactions', {headers: {'X-Message-Id': $threadMessageId, 'X-Emoji': '" emoji "'}});"
" $emojiOpen = false")}
emoji])]
[:button {:class "mt-2 w-full text-xs text-overlay0 hover:text-subtext0 py-1"
:data-on-click "$emojiOpen = false"}
"Close"]])
;;; ---------------------------------------------------------------------------
;;; Search Modal
;;; ---------------------------------------------------------------------------
(defn search-modal
"Full-screen search overlay with input and results."
[]
[:div {:class "flex items-start justify-center pt-20"}
;; Backdrop
[:div {:class "absolute inset-0 bg-black bg-opacity-50"
:data-on-click "$searchOpen = false"}]
;; Modal
[:div {:class "relative bg-mantle border border-surface1 rounded-xl shadow-2xl w-full max-w-2xl z-10"}
;; Search input
[:div {:class "flex items-center border-b border-surface1 px-4"}
[:svg {:class "w-5 h-5 text-overlay0 mr-3" :viewBox "0 0 24 24" :fill "none" :stroke "currentColor" :stroke-width "2"}
[:circle {:cx "11" :cy "11" :r "8"}]
[:line {:x1 "21" :y1 "21" :x2 "16.65" :y2 "16.65"}]]
[:input {:type "text"
:class "flex-1 bg-transparent text-text placeholder-overlay0 py-3 outline-none text-sm"
:placeholder "Search messages..."
:data-bind "searchQuery"
:data-on-keydown "if(evt.key === 'Enter') @post('/web/search')"
:autofocus true}]
[:button {:class "text-overlay0 hover:text-text ml-2"
:data-on-click "$searchOpen = false"}
[:span {:class "text-xs border border-surface1 rounded px-1.5 py-0.5"} "ESC"]]]
;; Search results container
[:div {:id "search-results" :class "max-h-96 overflow-y-auto p-4"}
[:div {:class "text-sm text-overlay0 text-center py-8"} "Type a query and press Enter to search."]]]])
(defn search-results
"Rendered search results to replace #search-results content."
[results]
(if (seq results)
[:div
[:div {:class "text-xs text-overlay0 mb-3"} (str (count results) " result(s) found")]
(for [msg results]
(let [msg-id (str (:id msg))
username (or (:display-name msg) (:username msg) "unknown")
body (or (:body-md msg) (:body_md msg) "")
ts (format-timestamp (or (:created-at msg) (:created_at msg)))]
[:div {:key msg-id
:class "flex items-start gap-3 p-2 rounded hover:bg-hover cursor-pointer"
:data-on-click (str "$searchOpen = false;"
" document.getElementById('msg-" msg-id "')?.scrollIntoView({behavior: 'smooth'})")}
[:div {:class "w-8 h-8 rounded-full flex items-center justify-center text-xs font-bold flex-shrink-0"
:style (str "background-color: " (avatar-color (:user-id msg)))}
(user-initials username)]
[:div {:class "flex-1 min-w-0"}
[:div {:class "flex items-baseline gap-2"}
[:span {:class "text-sm font-medium text-text"} username]
[:span {:class "text-xs text-overlay0"} ts]]
[:div {:class "text-sm text-subtext0 truncate"} body]]]))]
[:div {:class "text-sm text-overlay0 text-center py-8"} "No results found."]))
+102 -2
View File
@@ -1,5 +1,105 @@
(ns ajet.chat.web.core
"Web session manager http-kit + Hiccup + Datastar SSE.")
"Web session manager -- http-kit + Hiccup + Datastar SSE.
Manages the full lifecycle: NATS connection, connection tracker, HTTP server.
No direct PostgreSQL access -- all data goes through the API via shared api-client.
System state held in a single atom for REPL-driven development."
(:refer-clojure :exclude [reset!])
(:require [clojure.tools.logging :as log]
[org.httpkit.server :as http-kit]
[ajet.chat.shared.config :as config]
[ajet.chat.shared.eventbus :as eventbus]
[ajet.chat.shared.logging :as logging]
[ajet.chat.web.routes :as routes]
[ajet.chat.web.sse :as sse])
(:gen-class))
(defonce system (atom nil))
;;; ---------------------------------------------------------------------------
;;; Lifecycle
;;; ---------------------------------------------------------------------------
(defn start!
"Start the Web Session Manager. Connects to NATS and starts HTTP server."
[& [{:keys [config-overrides]}]]
(when @system
(log/warn "System already started -- call (stop!) first")
(throw (ex-info "System already running" {})))
(let [cfg (config/load-config {:resource "web-sm-config.edn"})
cfg (if config-overrides (merge cfg config-overrides) cfg)
_ (log/info "Loaded config:" (config/redact cfg))
;; NATS
nats (eventbus/connect! (:nats cfg))
_ (log/info "Connected to NATS")
;; Connection tracker -- per-user SSE state
connections (atom {})
;; System map (no DB -- web-sm proxies everything through the API)
api-url (get-in cfg [:api :base-url] "http://localhost:3001")
sys {:config cfg
:nats nats
:connections connections
:api-url api-url}
;; HTTP server
handler (routes/app sys)
port (get-in cfg [:server :port] 3002)
host (get-in cfg [:server :host] "0.0.0.0")
server (http-kit/run-server handler {:port port :ip host
:max-body (* 12 1024 1024)})]
(clojure.core/reset! system (assoc sys :server server :port port))
(log/info (str "Web session manager started on port " port))
@system))
(defn stop!
"Stop the Web Session Manager. Shuts down HTTP, SSE connections, NATS."
[]
(when-let [sys @system]
(log/info "Shutting down Web session manager...")
;; Disconnect all SSE clients
(when-let [connections (:connections sys)]
(sse/disconnect-all! connections (:nats sys))
(log/info "All SSE connections closed"))
;; Stop HTTP server (wait up to 30s for in-flight requests)
(when-let [server (:server sys)]
(server :timeout 30000)
(log/info "HTTP server stopped"))
;; Close NATS
(when-let [nats (:nats sys)]
(try
(eventbus/close! nats)
(log/info "NATS connection closed")
(catch Exception e
(log/error e "Error closing NATS connection"))))
(clojure.core/reset! system nil)
(log/info "Web session manager stopped")))
(defn reset!
"Stop then start the system (REPL convenience)."
[]
(stop!)
(start!))
;;; ---------------------------------------------------------------------------
;;; Entry point
;;; ---------------------------------------------------------------------------
(defn -main [& _args]
(println "ajet-chat web starting..."))
(start!)
;; Graceful shutdown hook
(.addShutdownHook
(Runtime/getRuntime)
(Thread. ^Runnable (fn []
(log/info "Shutdown hook triggered")
(stop!))))
;; Block main thread
@(promise))
+489
View File
@@ -0,0 +1,489 @@
(ns ajet.chat.web.handlers
"Signal handlers for POST /web/* endpoints.
Every handler:
1. Extracts params from the Datastar request (signals + custom headers)
2. Calls the API via shared api-client
3. Returns a Datastar fragment response (or empty 204)
All auth is handled by Auth GW upstream -- we receive X-User-Id, X-User-Role headers."
(:require [clojure.tools.logging :as log]
[clojure.string :as str]
[hiccup2.core :as h]
[ajet.chat.shared.api-client :as api]
[ajet.chat.shared.eventbus :as eventbus]
[ajet.chat.web.components :as c]
[ajet.chat.web.layout :as layout]
[ajet.chat.web.sse :as sse]))
;;; ---------------------------------------------------------------------------
;;; Helpers
;;; ---------------------------------------------------------------------------
(defn build-api-ctx
"Build an API client context from a Ring request and the system's API URL."
[request]
(let [api-url (get-in request [:system :api-url] "http://localhost:3001")]
(api/request->ctx request api-url)))
(defn- get-signal
"Extract a Datastar signal value from the request.
Signals come as JSON body params or query params depending on GET/POST."
[request signal-name]
(or (get-in request [:params (keyword signal-name)])
(get-in request [:body-params (keyword signal-name)])
(get-in request [:params signal-name])))
(defn- get-header
"Get a custom header value from the request."
[request header-name]
(get-in request [:headers (str/lower-case header-name)]))
(defn- datastar-fragment-response
"Return an SSE response with a Datastar patch-elements event.
Used for POST handlers that need to return a UI update."
[hiccup-fragment & [{:keys [selector mode] :or {mode "morph"}}]]
(let [html-str (str (h/html hiccup-fragment))
lines (cond-> []
selector (conj (str "selector " selector))
true (conj (str "mode " mode))
true (conj (str "elements " html-str)))]
{:status 200
:headers {"Content-Type" "text/event-stream"
"Cache-Control" "no-cache, no-store, must-revalidate"}
:body (str "event: datastar-patch-elements\n"
(apply str (map #(str "data: " % "\n") lines))
"\n")}))
(defn- datastar-signals-response
"Return an SSE response with a Datastar patch-signals event."
[signals-json]
{:status 200
:headers {"Content-Type" "text/event-stream"
"Cache-Control" "no-cache, no-store, must-revalidate"}
:body (str "event: datastar-patch-signals\n"
"data: signals " signals-json "\n"
"\n")})
(defn- datastar-remove-response
"Return an SSE response that removes a DOM element."
[selector]
{:status 200
:headers {"Content-Type" "text/event-stream"
"Cache-Control" "no-cache, no-store, must-revalidate"}
:body (str "event: datastar-patch-elements\n"
"data: selector " selector "\n"
"data: mode remove\n"
"data: elements <div></div>\n"
"\n")})
(defn- datastar-redirect-response
"Return an SSE response that redirects the browser."
[url]
{:status 200
:headers {"Content-Type" "text/event-stream"
"Cache-Control" "no-cache, no-store, must-revalidate"}
:body (str "event: datastar-execute-script\n"
"data: script window.location.href='" url "'\n"
"\n")})
(defn- empty-sse-response
"Return an empty SSE response (no events, connection closes after)."
[]
{:status 200
:headers {"Content-Type" "text/event-stream"
"Cache-Control" "no-cache, no-store, must-revalidate"}
:body "\n"})
;;; ---------------------------------------------------------------------------
;;; Message Handlers
;;; ---------------------------------------------------------------------------
(defn send-message-handler
"POST /web/messages -- send a new message.
The message will appear via SSE push from NATS, so we return empty."
[request]
(let [ctx (build-api-ctx request)
channel-id (or (get-header request "x-channel-id")
(get-signal request "activeChannel"))
parent-id (get-header request "x-parent-id")
body-text (or (get-signal request "messageText")
(get-signal request "threadReply")
"")
body-map (cond-> {:body_md body-text}
parent-id (assoc :parent_id parent-id))]
(when (and channel-id (not (str/blank? body-text)))
(api/send-message ctx channel-id body-map))
;; Clear the input and return empty response
(datastar-signals-response (if parent-id
"{threadReply: ''}"
"{messageText: ''}"))))
(defn edit-message-handler
"POST /web/messages/:id/edit -- edit a message."
[request]
(let [ctx (build-api-ctx request)
message-id (get-in request [:path-params :id])
body-text (or (get-signal request "editText")
(get-signal request "messageText")
"")]
(when (and message-id (not (str/blank? body-text)))
(api/edit-message ctx message-id {:body_md body-text}))
(empty-sse-response)))
(defn delete-message-handler
"POST /web/messages/:id/delete -- delete a message."
[request]
(let [ctx (build-api-ctx request)
message-id (get-in request [:path-params :id])]
(when message-id
(api/delete-message ctx message-id))
(empty-sse-response)))
;;; ---------------------------------------------------------------------------
;;; Reaction Handlers
;;; ---------------------------------------------------------------------------
(defn add-reaction-handler
"POST /web/reactions -- add a reaction to a message."
[request]
(let [ctx (build-api-ctx request)
message-id (or (get-header request "x-message-id")
(get-signal request "threadMessageId"))
emoji (or (get-header request "x-emoji")
(get-signal request "emoji"))]
(when (and message-id emoji)
(api/add-reaction ctx message-id emoji))
(empty-sse-response)))
(defn remove-reaction-handler
"POST /web/reactions/remove -- remove a reaction from a message."
[request]
(let [ctx (build-api-ctx request)
message-id (or (get-header request "x-message-id")
(get-signal request "messageId"))
emoji (or (get-header request "x-emoji")
(get-signal request "emoji"))]
(when (and message-id emoji)
(api/remove-reaction ctx message-id emoji))
(empty-sse-response)))
;;; ---------------------------------------------------------------------------
;;; Navigation Handler
;;; ---------------------------------------------------------------------------
(defn navigate-handler
"POST /web/navigate -- switch community or channel.
Updates connection tracking and re-subscribes NATS.
Returns the updated sidebar + message list + channel header."
[request]
(let [ctx (build-api-ctx request)
user-id (:user-id request)
connections (get-in request [:system :connections])
nats (get-in request [:system :nats])
target (get-header request "x-target")
community-id (or (get-header request "x-community-id")
(get-signal request "activeCommunity"))
channel-id (or (get-header request "x-channel-id")
(get-signal request "activeChannel"))]
(cond
;; Navigate to DMs view
(= target "dms")
(let [dms (api/get-dms ctx)
dm (first dms)
dm-id (when dm (str (:id dm)))
messages (when dm-id (api/get-messages ctx dm-id {:limit 50}))
user (api/get-me ctx)]
;; Re-subscribe NATS (no community context for DMs)
(when user-id
(sse/resubscribe! connections nats user-id nil dm-id))
;; Return updated UI fragments
(datastar-fragment-response
[:div {:id "app-content"}
;; Update sidebar with DM list
[:div {:id "sidebar"
:class "w-60 flex-shrink-0 bg-mantle flex flex-col border-r border-surface1"}
(c/dm-sidebar {:dms dms :active-dm dm :user user})]
;; Update channel header
[:div {:id "channel-header"}
(c/channel-header (or dm {:name "Direct Messages"}))]
;; Update messages
[:div {:id "message-list"
:class "flex-1 overflow-y-auto px-4 py-2"}
(c/message-list (reverse (or messages [])) user)]
;; Update input
[:div {:id "message-input-area" :class "px-4 pb-4"}
(c/message-input dm)]]))
;; Navigate to a specific channel
channel-id
(let [channel (api/get-channel ctx channel-id)
cid (or community-id (str (:community-id channel)))
community (when cid (api/get-community ctx cid))
channels (when cid (api/get-channels ctx cid))
messages (api/get-messages ctx channel-id {:limit 50})
categories (when cid (api/get-categories ctx cid))
user (api/get-me ctx)]
;; Re-subscribe NATS
(when user-id
(sse/resubscribe! connections nats user-id cid channel-id))
;; Return updated UI fragments
(datastar-fragment-response
[:div {:id "app-content"}
[:div {:id "sidebar"
:class "w-60 flex-shrink-0 bg-mantle flex flex-col border-r border-surface1"}
(c/sidebar {:community community
:channels channels
:channel channel
:categories categories
:user user})]
[:div {:id "channel-header"}
(c/channel-header channel)]
[:div {:id "message-list"
:class "flex-1 overflow-y-auto px-4 py-2"}
(c/message-list (reverse (or messages [])) user)]
[:div {:id "message-input-area" :class "px-4 pb-4"}
(c/message-input channel)]]))
;; Navigate to a community (pick first channel)
community-id
(let [community (api/get-community ctx community-id)
channels (api/get-channels ctx community-id)
channel (first (filter #(= "text" (name (or (:type %) :text))) channels))
ch-id (when channel (str (:id channel)))
messages (when ch-id (api/get-messages ctx ch-id {:limit 50}))
categories (api/get-categories ctx community-id)
user (api/get-me ctx)]
;; Re-subscribe NATS
(when user-id
(sse/resubscribe! connections nats user-id community-id ch-id))
;; Return updated UI
(datastar-fragment-response
[:div {:id "app-content"}
[:div {:id "community-strip"
:class "w-[72px] flex-shrink-0 bg-mantle flex flex-col items-center py-3 gap-2 overflow-y-auto"}
(c/community-strip {:communities (api/get-communities ctx)
:active-id community-id
:unread-count 0})]
[:div {:id "sidebar"
:class "w-60 flex-shrink-0 bg-mantle flex flex-col border-r border-surface1"}
(c/sidebar {:community community
:channels channels
:channel channel
:categories categories
:user user})]
[:div {:id "channel-header"}
(c/channel-header channel)]
[:div {:id "message-list"
:class "flex-1 overflow-y-auto px-4 py-2"}
(c/message-list (reverse (or messages [])) user)]
[:div {:id "message-input-area" :class "px-4 pb-4"}
(c/message-input channel)]]))
:else
(empty-sse-response))))
;;; ---------------------------------------------------------------------------
;;; Mark Read Handler
;;; ---------------------------------------------------------------------------
(defn mark-read-handler
"POST /web/read -- mark a channel as read up to the latest message."
[request]
(let [ctx (build-api-ctx request)
channel-id (or (get-header request "x-channel-id")
(get-signal request "activeChannel"))
message-id (or (get-header request "x-message-id")
(get-signal request "lastMessageId"))]
(when (and channel-id message-id)
(api/mark-read ctx channel-id {:last-read-message-id message-id}))
(empty-sse-response)))
;;; ---------------------------------------------------------------------------
;;; Upload Handler
;;; ---------------------------------------------------------------------------
(defn upload-handler
"POST /web/upload -- forward a multipart file upload to the API.
Returns empty (the attachment will appear in the message via SSE)."
[request]
(let [ctx (build-api-ctx request)
channel-id (or (get-header request "x-channel-id")
(get-signal request "activeChannel"))
file (get-in request [:multipart-params "file"])
tempfile (:tempfile file)
filename (:filename file)
ctype (:content-type file)]
(when (and channel-id tempfile)
(api/upload-file ctx channel-id (str tempfile) (or ctype "image/png")))
(empty-sse-response)))
;;; ---------------------------------------------------------------------------
;;; Typing Handler
;;; ---------------------------------------------------------------------------
(defn typing-handler
"POST /web/typing -- publish a typing indicator directly to NATS (ephemeral).
Bypasses the API for low latency."
[request]
(let [nats (get-in request [:system :nats])
user-id (:user-id request)
connections (get-in request [:system :connections])
conn-state (get @connections user-id)
community-id (or (get-header request "x-channel-id")
(:active-community conn-state))
channel-id (or (get-header request "x-channel-id")
(:active-channel conn-state))
username (or (get-in conn-state [:user :display-name])
(get-in conn-state [:user :username])
"Someone")]
(when (and nats community-id channel-id)
(eventbus/publish! nats
(str "chat.typing." community-id "." channel-id)
:typing/started
{:user-id user-id
:username username
:channel-id channel-id}))
(empty-sse-response)))
;;; ---------------------------------------------------------------------------
;;; Search Handler
;;; ---------------------------------------------------------------------------
(defn search-handler
"POST /web/search -- search messages via the API and return results fragment."
[request]
(let [ctx (build-api-ctx request)
query (or (get-signal request "searchQuery") "")
conn (get @(get-in request [:system :connections]) (:user-id request))
cid (:active-community conn)]
(if (str/blank? query)
(datastar-fragment-response
[:div {:id "search-results" :class "max-h-96 overflow-y-auto p-4"}
[:div {:class "text-sm text-overlay0 text-center py-8"}
"Type a query and press Enter to search."]]
{:selector "#search-results"})
(let [results (api/search ctx (cond-> {:q query}
cid (assoc :community-id cid)))]
(datastar-fragment-response
[:div {:id "search-results" :class "max-h-96 overflow-y-auto p-4"}
(c/search-results (or (:results results) results []))]
{:selector "#search-results"})))))
;;; ---------------------------------------------------------------------------
;;; Slash Command Handler
;;; ---------------------------------------------------------------------------
(defn command-handler
"POST /web/command -- execute a slash command via the API."
[request]
(let [ctx (build-api-ctx request)
text (or (get-signal request "commandText")
(get-signal request "messageText") "")
conn (get @(get-in request [:system :connections]) (:user-id request))
channel-id (:active-channel conn)
community-id (:active-community conn)]
(if (str/blank? text)
(empty-sse-response)
(let [;; Parse slash command: /command arg1 arg2
parts (str/split (str/trim text) #"\s+" 2)
command (str/replace (first parts) #"^/" "")
args (second parts)
result (api/execute-command ctx
(cond-> {:command command}
args (assoc :args args)
channel-id (assoc :channel-id channel-id)
community-id (assoc :community-id community-id)))]
;; Return the command result as a message-like fragment
(if (:error result)
(datastar-fragment-response
[:div {:id "command-result"
:class "px-4 py-2 text-sm text-red bg-surface0 rounded mx-4 mb-2"}
(str "Error: " (:message (:error result) "Command failed"))]
{:selector "#message-input-area"
:mode "prepend"})
(datastar-fragment-response
[:div {:id "command-result"
:class "px-4 py-2 text-sm text-green bg-surface0 rounded mx-4 mb-2"}
(or (:message result) (:body result) "Command executed.")]
{:selector "#message-input-area"
:mode "prepend"}))))))
;;; ---------------------------------------------------------------------------
;;; Create Community Handler
;;; ---------------------------------------------------------------------------
(defn create-community-handler
"POST /web/communities -- create a new community, then redirect to /app."
[request]
(let [ctx (build-api-ctx request)
name (or (get-signal request "communityName")
(get-in request [:params :name]) "")
slug (or (get-signal request "communitySlug")
(get-in request [:params :slug]) "")]
(if (or (str/blank? name) (str/blank? slug))
(datastar-fragment-response
[:div {:id "setup-error" :class "mt-4 text-red text-sm text-center"}
"Please provide both a name and URL slug."]
{:selector "#setup-error"})
(try
(api/create-community ctx {:name name :slug slug})
(datastar-redirect-response "/app")
(catch clojure.lang.ExceptionInfo e
(let [data (ex-data e)
msg (or (get-in data [:body :error :message])
(ex-message e)
"Failed to create community")]
(datastar-fragment-response
[:div {:id "setup-error" :class "mt-4 text-red text-sm text-center"}
msg]
{:selector "#setup-error"})))))))
;;; ---------------------------------------------------------------------------
;;; Create Channel Handler
;;; ---------------------------------------------------------------------------
(defn create-channel-handler
"POST /web/channels -- create a new channel in the active community."
[request]
(let [ctx (build-api-ctx request)
conn (get @(get-in request [:system :connections]) (:user-id request))
community-id (or (get-header request "x-community-id")
(:active-community conn))
name (or (get-signal request "channelName")
(get-in request [:params :name]) "")
ch-type (or (get-signal request "channelType") "text")
visibility (or (get-signal request "channelVisibility") "public")]
(if (or (str/blank? community-id) (str/blank? name))
(datastar-fragment-response
[:div {:id "create-channel-error" :class "text-red text-sm"}
"Please provide a channel name."])
(try
(let [channel (api/create-channel ctx community-id
{:name name :type ch-type :visibility visibility})]
;; Navigate to the new channel
(datastar-redirect-response (str "/app/channel/" (:id channel))))
(catch clojure.lang.ExceptionInfo e
(let [data (ex-data e)
msg (or (get-in data [:body :error :message])
(ex-message e)
"Failed to create channel")]
(datastar-fragment-response
[:div {:id "create-channel-error" :class "text-red text-sm"} msg])))))))
;;; ---------------------------------------------------------------------------
;;; Health Check
;;; ---------------------------------------------------------------------------
(defn health-handler
"GET /web/health -- health check returning NATS connection status."
[request]
(let [nats (get-in request [:system :nats])
conns (get-in request [:system :connections])
healthy (and nats (eventbus/connected? nats))]
{:status (if healthy 200 503)
:headers {"Content-Type" "application/json"}
:body (str "{\"status\":\"" (if healthy "ok" "degraded") "\","
"\"nats\":" (if healthy "true" "false") ","
"\"active_connections\":" (count @conns) "}")}))
+244
View File
@@ -0,0 +1,244 @@
(ns ajet.chat.web.layout
"Hiccup layout templates for the web UI.
Renders full HTML pages with Tailwind CSS (CDN), Datastar (CDN),
and a Catppuccin Mocha dark theme.
Layout is a Discord-style 4-pane design:
community-strip | sidebar | message-list | (optional thread panel)"
(:require [hiccup2.core :as h]
[ajet.chat.web.components :as c]))
;;; ---------------------------------------------------------------------------
;;; Color Palette (Catppuccin Mocha)
;;; ---------------------------------------------------------------------------
(def ^:private colors
{:base "#1e1e2e"
:mantle "#181825"
:surface0 "#313244"
:surface1 "#45475a"
:surface2 "#585b70"
:overlay0 "#6c7086"
:overlay1 "#7f849c"
:subtext0 "#a6adc8"
:subtext1 "#bac2de"
:text "#cdd6f4"
:lavender "#b4befe"
:blue "#89b4fa"
:sapphire "#74c7ec"
:sky "#89dceb"
:teal "#94e2d5"
:green "#a6e3a1"
:yellow "#f9e2af"
:peach "#fab387"
:maroon "#eba0ac"
:red "#f38ba8"
:mauve "#cba6f7"
:pink "#f5c2e7"
:flamingo "#f2cdcd"
:rosewater "#f5e0dc"
:hover "#2a2a3c"})
;;; ---------------------------------------------------------------------------
;;; Base Page Shell
;;; ---------------------------------------------------------------------------
(defn base-page
"Full HTML document wrapper with Tailwind CDN, Datastar CDN, and dark theme CSS."
[{:keys [title]} & body]
(str
"<!DOCTYPE html>"
(h/html
[:html {:lang "en" :class "dark"}
[:head
[:meta {:charset "UTF-8"}]
[:meta {:name "viewport" :content "width=device-width, initial-scale=1.0"}]
[:title (or title "ajet chat")]
;; Tailwind CSS via CDN
[:script {:src "https://cdn.tailwindcss.com"}]
[:script
(h/raw
"tailwind.config = {
darkMode: 'class',
theme: {
extend: {
colors: {
base: '#1e1e2e',
mantle: '#181825',
surface0: '#313244',
surface1: '#45475a',
surface2: '#585b70',
overlay0: '#6c7086',
overlay1: '#7f849c',
subtext0: '#a6adc8',
subtext1: '#bac2de',
text: '#cdd6f4',
blue: '#89b4fa',
green: '#a6e3a1',
red: '#f38ba8',
yellow: '#f9e2af',
mauve: '#cba6f7',
peach: '#fab387',
hover: '#2a2a3c',
}
}
}
}")]
;; Datastar via CDN
[:script {:type "module" :src "https://cdn.jsdelivr.net/gh/starfederation/datastar@v1.0.0-RC.7/bundles/datastar.js"}]
;; Custom styles
[:style
(h/raw
"* { box-sizing: border-box; }
body { margin: 0; padding: 0; font-family: 'Inter', system-ui, -apple-system, sans-serif; }
::-webkit-scrollbar { width: 8px; }
::-webkit-scrollbar-track { background: #1e1e2e; }
::-webkit-scrollbar-thumb { background: #45475a; border-radius: 4px; }
::-webkit-scrollbar-thumb:hover { background: #585b70; }
.spoiler { background: #313244; color: transparent; border-radius: 3px; padding: 0 4px; cursor: pointer; transition: color 0.2s; }
.spoiler:hover { color: #cdd6f4; }
code { background: #313244; padding: 2px 6px; border-radius: 3px; font-size: 0.875em; }
pre code { background: none; padding: 0; }
pre { background: #313244; padding: 12px; border-radius: 6px; overflow-x: auto; }
blockquote { border-left: 3px solid #45475a; padding-left: 12px; margin: 4px 0; color: #a6adc8; }
a { color: #89b4fa; text-decoration: none; }
a:hover { text-decoration: underline; }
.toast-enter { animation: slideIn 0.3s ease-out; }
@keyframes slideIn { from { transform: translateX(100%); opacity: 0; } to { transform: translateX(0); opacity: 1; } }
.emoji-btn { cursor: pointer; padding: 4px; border-radius: 4px; transition: background 0.15s; }
.emoji-btn:hover { background: #45475a; }")]]
[:body {:class "bg-base text-text h-screen overflow-hidden"}
body]])))
;;; ---------------------------------------------------------------------------
;;; App Layout (4-pane Discord-style)
;;; ---------------------------------------------------------------------------
(defn app-page
"Full chat application page with all panes populated from initial data."
[{:keys [user communities community channels channel messages categories unread-count
dm-view? dms]}]
(let [community-id (when community (str (:id community)))
channel-id (when channel (str (:id channel)))]
(base-page
{:title (str (when channel (str "#" (:name channel) " - "))
(when community (:name community))
" - ajet chat")}
;; Datastar signals for client state
[:div {:id "app-state"
:data-signals (str "{activeCommunity: '" (or community-id "") "',"
" activeChannel: '" (or channel-id "") "',"
" messageText: '',"
" searchQuery: '',"
" searchOpen: false,"
" emojiOpen: false,"
" threadOpen: false,"
" threadMessageId: '',"
" commandText: '',"
" unreadCount: " (or unread-count 0) "}")
;; Auto-connect to SSE on page load
:data-init (str "@get('/sse/events', {openWhenHidden: true})")}]
;; Main 4-pane layout
[:div {:class "flex h-screen"}
;; Pane 1: Community strip
[:div {:id "community-strip"
:class "w-[72px] flex-shrink-0 bg-mantle flex flex-col items-center py-3 gap-2 overflow-y-auto"}
(c/community-strip {:communities communities
:active-id community-id
:unread-count unread-count})]
;; Pane 2: Sidebar
[:div {:id "sidebar"
:class "w-60 flex-shrink-0 bg-mantle flex flex-col border-r border-surface1"}
(if dm-view?
(c/dm-sidebar {:dms dms :active-dm channel :user user})
(c/sidebar {:community community
:channels channels
:channel channel
:categories categories
:user user}))]
;; Pane 3: Main content area (message list + input)
[:div {:class "flex-1 flex flex-col min-w-0"}
;; Channel header
[:div {:id "channel-header"}
(c/channel-header channel)]
;; Messages
[:div {:id "message-list"
:class "flex-1 overflow-y-auto px-4 py-2"
:data-on-scroll (str "if(evt.target.scrollTop === 0) {"
" @post('/web/messages', {headers: {'X-Load-Older': 'true'}})"
"}")}
(c/message-list messages user)]
;; Message input
[:div {:id "message-input-area"
:class "px-4 pb-4"}
(c/message-input channel)]]
;; Pane 4: Thread panel (hidden by default)
[:div {:id "thread-panel"
:class "w-96 flex-shrink-0 bg-mantle border-l border-surface1 flex-col hidden"
:data-class-hidden "!$threadOpen"}]]
;; Notification toast container
[:div {:id "toast-container"
:class "fixed top-4 right-4 z-50 flex flex-col gap-2"}]
;; Search modal (hidden by default)
[:div {:id "search-modal"
:class "fixed inset-0 z-40 hidden"
:data-class-hidden "!$searchOpen"}
(c/search-modal)]
;; Emoji picker (hidden by default)
[:div {:id "emoji-picker"
:class "fixed z-30 hidden"
:data-class-hidden "!$emojiOpen"}
(c/emoji-picker)])))
;;; ---------------------------------------------------------------------------
;;; Setup Page
;;; ---------------------------------------------------------------------------
(defn setup-page
"Community creation wizard for first-time users."
[]
(base-page
{:title "Create Community - ajet chat"}
[:div {:class "flex items-center justify-center min-h-screen"}
[:div {:class "w-full max-w-md p-8 bg-mantle rounded-xl border border-surface1"}
[:h1 {:class "text-2xl font-bold text-text mb-2 text-center"} "Welcome to ajet chat"]
[:p {:class "text-subtext0 text-center mb-8"} "Create your first community to get started."]
[:form {:data-on-submit "@post('/web/communities')"}
[:div {:class "mb-4"}
[:label {:class "block text-sm font-medium text-subtext1 mb-1" :for "community-name"} "Community Name"]
[:input {:type "text"
:id "community-name"
:name "name"
:data-bind "communityName"
:data-signals-community-name ""
:required true
:placeholder "My Team"
:class "w-full px-3 py-2 bg-surface0 border border-surface1 rounded-lg text-text
placeholder-overlay0 focus:outline-none focus:border-blue"}]]
[:div {:class "mb-6"}
[:label {:class "block text-sm font-medium text-subtext1 mb-1" :for "community-slug"} "URL Slug"]
[:input {:type "text"
:id "community-slug"
:name "slug"
:data-bind "communitySlug"
:data-signals-community-slug ""
:required true
:pattern "[a-z0-9][a-z0-9-]*[a-z0-9]"
:placeholder "my-team"
:class "w-full px-3 py-2 bg-surface0 border border-surface1 rounded-lg text-text
placeholder-overlay0 focus:outline-none focus:border-blue"}]
[:p {:class "text-xs text-overlay0 mt-1"} "Lowercase letters, digits, and hyphens only."]]
[:button {:type "submit"
:class "w-full py-2 px-4 bg-blue text-base font-semibold rounded-lg
hover:opacity-90 transition-opacity"}
"Create Community"]
[:div {:id "setup-error" :class "mt-4 text-red text-sm text-center"}]]]]))
+214
View File
@@ -0,0 +1,214 @@
(ns ajet.chat.web.routes
"Reitit router for the Web Session Manager.
Routes fall into three categories:
1. Page routes (GET /app/*) -- full Hiccup page renders
2. SSE endpoint (GET /sse/events) -- Datastar SSE stream
3. Signal handlers (POST /web/*) -- browser actions proxied to API"
(:require [clojure.tools.logging :as log]
[reitit.ring :as ring]
[ring.middleware.params :refer [wrap-params]]
[ring.middleware.multipart-params :refer [wrap-multipart-params]]
[ring.middleware.keyword-params :refer [wrap-keyword-params]]
[ajet.chat.shared.api-client :as api]
[ajet.chat.shared.logging :as logging]
[ajet.chat.web.handlers :as handlers]
[ajet.chat.web.layout :as layout]
[ajet.chat.web.sse :as sse]))
;;; ---------------------------------------------------------------------------
;;; Middleware
;;; ---------------------------------------------------------------------------
(defn wrap-system
"Inject system components into each request under :system."
[handler system]
(fn [request]
(handler (assoc request :system system))))
(defn wrap-user-context
"Extract Auth GW headers into request keys for convenience."
[handler]
(fn [request]
(let [headers (:headers request)
user-id (get headers "x-user-id")
user-role (get headers "x-user-role")
community-id (get headers "x-community-id")]
(handler (cond-> request
user-id (assoc :user-id user-id)
user-role (assoc :user-role user-role)
community-id (assoc :community-id community-id))))))
(defn wrap-exception-handler
"Catch-all exception handler. Returns a simple HTML error page."
[handler]
(fn [request]
(try
(handler request)
(catch clojure.lang.ExceptionInfo e
(let [data (ex-data e)]
(if (= :ajet.chat/api-error (:type data))
{:status (:status data 500)
:headers {"Content-Type" "text/html; charset=utf-8"}
:body (str "<html><body><h1>Error " (:status data) "</h1>"
"<p>" (ex-message e) "</p></body></html>")}
(do
(log/error e "Unhandled exception" (pr-str data))
{:status 500
:headers {"Content-Type" "text/html; charset=utf-8"}
:body "<html><body><h1>Internal Server Error</h1></body></html>"}))))
(catch Exception e
(log/error e "Unhandled exception")
{:status 500
:headers {"Content-Type" "text/html; charset=utf-8"}
:body "<html><body><h1>Internal Server Error</h1></body></html>"}))))
;;; ---------------------------------------------------------------------------
;;; Page Handlers
;;; ---------------------------------------------------------------------------
(defn index-handler
"GET / -- redirect to /app if user has communities, /setup otherwise."
[request]
(let [ctx (handlers/build-api-ctx request)]
(try
(let [communities (api/get-communities ctx)]
(if (seq communities)
{:status 302 :headers {"Location" "/app"} :body ""}
{:status 302 :headers {"Location" "/setup"} :body ""}))
(catch Exception _
{:status 302 :headers {"Location" "/setup"} :body ""}))))
(defn app-handler
"GET /app -- main chat page. Fetches communities, channels, messages for initial render."
[request]
(let [ctx (handlers/build-api-ctx request)
user (api/get-me ctx)
communities (api/get-communities ctx)
community (first communities)
community-id (when community (str (:id community)))
channels (when community-id
(api/get-channels ctx community-id))
channel (first (filter #(= "text" (name (or (:type %) :text))) channels))
channel-id (when channel (str (:id channel)))
messages (when channel-id
(api/get-messages ctx channel-id {:limit 50}))
categories (when community-id
(api/get-categories ctx community-id))
unread (try (api/get-unread-count ctx) (catch Exception _ {:count 0}))]
{:status 200
:headers {"Content-Type" "text/html; charset=utf-8"}
:body (layout/app-page {:user user
:communities communities
:community community
:channels channels
:channel channel
:messages (reverse (or messages []))
:categories categories
:unread-count (:count unread 0)})}))
(defn channel-handler
"GET /app/channel/:id -- direct link to a specific channel."
[request]
(let [channel-id (get-in request [:path-params :id])
ctx (handlers/build-api-ctx request)
user (api/get-me ctx)
channel (api/get-channel ctx channel-id)
community-id (str (:community-id channel))
communities (api/get-communities ctx)
community (first (filter #(= (str (:id %)) community-id) communities))
channels (api/get-channels ctx community-id)
messages (api/get-messages ctx channel-id {:limit 50})
categories (api/get-categories ctx community-id)
unread (try (api/get-unread-count ctx) (catch Exception _ {:count 0}))]
{:status 200
:headers {"Content-Type" "text/html; charset=utf-8"}
:body (layout/app-page {:user user
:communities communities
:community community
:channels channels
:channel channel
:messages (reverse (or messages []))
:categories categories
:unread-count (:count unread 0)})}))
(defn dm-handler
"GET /app/dm/:id -- direct link to a DM channel."
[request]
(let [dm-id (get-in request [:path-params :id])
ctx (handlers/build-api-ctx request)
user (api/get-me ctx)
communities (api/get-communities ctx)
dms (api/get-dms ctx)
active-dm (api/get-channel ctx dm-id)
messages (api/get-messages ctx dm-id {:limit 50})
unread (try (api/get-unread-count ctx) (catch Exception _ {:count 0}))]
{:status 200
:headers {"Content-Type" "text/html; charset=utf-8"}
:body (layout/app-page {:user user
:communities communities
:community nil
:channels []
:channel active-dm
:messages (reverse (or messages []))
:categories []
:unread-count (:count unread 0)
:dm-view? true
:dms dms})}))
(defn setup-handler
"GET /setup -- community creation wizard."
[request]
{:status 200
:headers {"Content-Type" "text/html; charset=utf-8"}
:body (layout/setup-page)})
;;; ---------------------------------------------------------------------------
;;; Router
;;; ---------------------------------------------------------------------------
(defn routes []
[["/" {:get {:handler index-handler}}]
["/app" {:get {:handler app-handler}}]
["/app/channel/:id" {:get {:handler channel-handler}}]
["/app/dm/:id" {:get {:handler dm-handler}}]
["/setup" {:get {:handler setup-handler}}]
;; SSE stream for real-time updates
["/sse/events" {:get {:handler sse/sse-handler}}]
;; Signal handlers (POST actions from browser)
["/web"
["/messages" {:post {:handler handlers/send-message-handler}}]
["/messages/:id/edit" {:post {:handler handlers/edit-message-handler}}]
["/messages/:id/delete" {:post {:handler handlers/delete-message-handler}}]
["/reactions" {:post {:handler handlers/add-reaction-handler}}]
["/reactions/remove" {:post {:handler handlers/remove-reaction-handler}}]
["/navigate" {:post {:handler handlers/navigate-handler}}]
["/read" {:post {:handler handlers/mark-read-handler}}]
["/upload" {:post {:handler handlers/upload-handler}}]
["/typing" {:post {:handler handlers/typing-handler}}]
["/search" {:post {:handler handlers/search-handler}}]
["/command" {:post {:handler handlers/command-handler}}]
["/communities" {:post {:handler handlers/create-community-handler}}]
["/channels" {:post {:handler handlers/create-channel-handler}}]
["/health" {:get {:handler handlers/health-handler}}]]])
(defn app
"Build the Ring handler with all middleware applied."
[system]
(ring/ring-handler
(ring/router (routes))
(ring/create-default-handler
{:not-found (constantly {:status 404
:headers {"Content-Type" "text/html; charset=utf-8"}
:body "<html><body><h1>404 Not Found</h1></body></html>"})})
{:middleware [[wrap-system system]
wrap-params
wrap-keyword-params
wrap-multipart-params
wrap-user-context
logging/wrap-request-logging
wrap-exception-handler]}))
+470
View File
@@ -0,0 +1,470 @@
(ns ajet.chat.web.sse
"SSE/Datastar handler for real-time browser updates.
Uses http-kit's with-channel for async SSE streaming.
On connect: subscribes to NATS subjects for the user's communities, DMs, notifications.
On NATS event: renders a Hiccup fragment and sends as Datastar SSE event.
On disconnect: unsubscribes from NATS and cleans up connection state.
Connection tracking atom shape:
{user-id {:sse-channel <http-kit-channel>
:active-community \"uuid\"
:active-channel \"uuid\"
:nats-subs [dispatcher1 dispatcher2 ...]
:last-seen <Instant>}}"
(:require [org.httpkit.server :as hk]
[clojure.tools.logging :as log]
[hiccup2.core :as h]
[ajet.chat.shared.api-client :as api]
[ajet.chat.shared.eventbus :as eventbus]
[ajet.chat.shared.markdown :as markdown]
[ajet.chat.shared.mentions :as mentions]
[ajet.chat.web.components :as c])
(:import [java.time Instant]))
;;; ---------------------------------------------------------------------------
;;; Datastar SSE Protocol
;;; ---------------------------------------------------------------------------
(defn- sse-event
"Format a Datastar SSE event string.
event-type: :patch-elements, :remove-element, :patch-signals, :execute-script
data-lines: map of data line key/value pairs.
Datastar SSE format:
event: datastar-patch-elements
data: selector #target-id
data: mode morph
data: elements <div>...</div>"
[event-type data-lines]
(let [event-name (case event-type
:patch-elements "datastar-patch-elements"
:remove-element "datastar-patch-elements"
:patch-signals "datastar-patch-signals"
:execute-script "datastar-execute-script"
(str "datastar-" (name event-type)))]
(str "event: " event-name "\n"
(apply str
(for [[k v] data-lines]
(str "data: " (name k) " " v "\n")))
"\n")))
(defn- send-sse!
"Send an SSE event to an http-kit channel. Returns false if channel is closed."
[ch event-str]
(try
(hk/send! ch event-str false)
true
(catch Exception e
(log/debug "SSE send failed:" (ex-message e))
false)))
(defn- send-patch!
"Send a Datastar patch-elements event with rendered Hiccup."
([ch hiccup-fragment]
(send-patch! ch hiccup-fragment {}))
([ch hiccup-fragment {:keys [selector mode]
:or {mode "morph"}}]
(let [html-str (str (h/html hiccup-fragment))
lines (cond-> []
selector (conj [:selector selector])
true (conj [:mode mode])
true (conj [:elements html-str]))]
(send-sse! ch (sse-event :patch-elements lines)))))
(defn- send-append!
"Send a Datastar patch-elements event in append mode."
[ch selector hiccup-fragment]
(let [html-str (str (h/html hiccup-fragment))]
(send-sse! ch (sse-event :patch-elements
[[:selector selector]
[:mode "append"]
[:elements html-str]]))))
(defn- send-remove!
"Send a Datastar remove event."
[ch selector]
(send-sse! ch (sse-event :remove-element
[[:selector selector]
[:mode "remove"]
[:elements "<div></div>"]])))
(defn- send-signals!
"Send a Datastar patch-signals event."
[ch signals-json]
(send-sse! ch (sse-event :patch-signals
[[:signals signals-json]])))
(defn- send-script!
"Send a Datastar execute-script event."
[ch script]
(send-sse! ch (sse-event :execute-script
[[:script script]])))
;;; ---------------------------------------------------------------------------
;;; NATS Event Handlers
;;; ---------------------------------------------------------------------------
(defn- handle-message-created
"New message arrived -- append to message list."
[ch event user]
(let [payload (:payload event)
msg payload]
(send-append! ch "#messages-container"
(c/message-component msg user))))
(defn- handle-message-updated
"Message edited -- replace the message element."
[ch event user]
(let [payload (:payload event)
msg payload
msg-id (str (:id msg))]
(send-patch! ch
(c/message-component msg user)
{:selector (str "#msg-" msg-id)})))
(defn- handle-message-deleted
"Message deleted -- remove from DOM."
[ch event _user]
(let [msg-id (str (get-in event [:payload :id]))]
(send-remove! ch (str "#msg-" msg-id))))
(defn- handle-reaction-updated
"Reaction added/removed -- replace the reactions bar on the message."
[ch event _user]
(let [payload (:payload event)
msg-id (str (:message-id payload (:message_id payload)))
reactions (or (:reactions payload) [])]
(if (seq reactions)
(send-patch! ch
[:div {:id (str "reactions-" msg-id)
:class "flex flex-wrap gap-1 mt-1"}
(for [r reactions]
[:button {:key (str (:emoji r))
:class "flex items-center gap-1 px-2 py-0.5 rounded-full text-xs bg-surface0 border border-surface1 hover:border-blue transition-colors"
:data-on-click (str "@post('/web/reactions', {headers: {'X-Message-Id': '" msg-id "', 'X-Emoji': '" (:emoji r) "'}})")}
[:span (:emoji r)]
[:span {:class "text-subtext0"} (count (:users r))]])]
{:selector (str "#reactions-" msg-id)})
(send-remove! ch (str "#reactions-" msg-id)))))
(defn- handle-typing
"Typing indicator -- update the typing area."
[ch event _user]
(let [payload (:payload event)
username (or (:username payload) (:display-name payload) "Someone")
user-id (str (:user-id payload (:user_id payload)))]
(send-patch! ch
[:div {:id "typing-indicator" :class "px-4 py-1 text-xs text-overlay0 h-6"}
[:span (str username " is typing...")]]
{:selector "#typing-indicator"})
;; Clear typing indicator after 3 seconds via script
(send-script! ch
(str "setTimeout(() => {"
" let el = document.getElementById('typing-indicator');"
" if(el) el.innerHTML = '';"
"}, 3000)"))))
(defn- handle-presence-update
"User presence changed -- update the presence dot."
[ch event _user]
(let [payload (:payload event)
uid (str (:user-id payload (:user_id payload)))
online (:online payload true)]
(send-patch! ch
[:span {:id (str "presence-" uid)
:class (str "ml-auto w-2 h-2 rounded-full "
(if online "bg-green" "bg-overlay0")
(when-not online " hidden"))}]
{:selector (str "#presence-" uid)})))
(defn- handle-channel-created
"New channel created -- append to sidebar."
[ch event _user]
(let [payload (:payload event)
channel payload
cid (str (:id channel))
ch-type (or (:type channel) "text")
prefix (if (= ch-type "voice") "\uD83D\uDD0A" "#")]
(send-append! ch "#channel-list"
[:div {:id (str "sidebar-channel-" cid)
:class "flex items-center px-2 py-1 rounded cursor-pointer text-sm text-overlay1 hover:text-subtext1 hover:bg-hover"
:data-on-click (str "@post('/web/navigate', {headers: {'X-Channel-Id': '" cid "'}})")}
[:span {:class "mr-1.5 text-overlay0 text-xs"} prefix]
[:span {:class "truncate"} (:name channel)]
[:span {:id (str "unread-badge-" cid)
:class "ml-auto hidden bg-red text-base text-xs font-bold rounded-full px-1.5 min-w-[1.25rem] text-center"}]])))
(defn- handle-unread-count
"Unread count changed -- update badge on sidebar channel."
[ch event _user]
(let [payload (:payload event)
channel-id (str (:channel-id payload (:channel_id payload)))
count (:count payload 0)]
(if (pos? count)
(send-patch! ch
[:span {:id (str "unread-badge-" channel-id)
:class "ml-auto bg-red text-base text-xs font-bold rounded-full px-1.5 min-w-[1.25rem] text-center"}
(str count)]
{:selector (str "#unread-badge-" channel-id)})
(send-patch! ch
[:span {:id (str "unread-badge-" channel-id)
:class "ml-auto hidden bg-red text-base text-xs font-bold rounded-full px-1.5 min-w-[1.25rem] text-center"}]
{:selector (str "#unread-badge-" channel-id)}))))
(defn- handle-notification
"Notification received -- update notification badge and show toast."
[ch event _user]
(let [payload (:payload event)
n-type (keyword (or (:notification-type payload) (:type payload) "mention"))
count (:unread-count payload 1)]
;; Update notification badge
(when (pos? count)
(send-patch! ch
[:span {:id "notification-badge"
:class "absolute -top-1 -right-1 bg-red text-base text-xs font-bold rounded-full w-5 h-5 flex items-center justify-center"}
(if (> count 99) "99+" (str count))]
{:selector "#notification-badge"})
(send-signals! ch (str "{unreadCount: " count "}")))
;; Show toast
(send-append! ch "#toast-container"
(c/notification-toast {:id (str (java.util.UUID/randomUUID))
:title (case n-type
:mention "New Mention"
:dm "New Direct Message"
:thread-reply "Thread Reply"
:invite "Invitation"
"Notification")
:body (or (:preview payload) (:body payload) "")
:type n-type}))
;; Auto-dismiss toast after 5 seconds
(send-script! ch
"setTimeout(() => { let t = document.querySelector('#toast-container > div:first-child'); if(t) t.remove(); }, 5000)")))
;;; ---------------------------------------------------------------------------
;;; NATS Event Router
;;; ---------------------------------------------------------------------------
(defn- route-event
"Route a NATS event to the appropriate handler based on event type."
[ch event user]
(let [event-type (keyword (or (:type event) "unknown"))]
(log/debug "SSE routing event:" event-type)
(case event-type
:message/created (handle-message-created ch event user)
:message/updated (handle-message-updated ch event user)
:message/deleted (handle-message-deleted ch event user)
:reaction/added (handle-reaction-updated ch event user)
:reaction/removed (handle-reaction-updated ch event user)
:typing/started (handle-typing ch event user)
:presence/updated (handle-presence-update ch event user)
:channel/created (handle-channel-created ch event user)
:unread/updated (handle-unread-count ch event user)
:notification/created (handle-notification ch event user)
(log/debug "Unhandled NATS event type:" event-type))))
;;; ---------------------------------------------------------------------------
;;; NATS Subscription Management
;;; ---------------------------------------------------------------------------
(defn- subscribe-user!
"Subscribe to all relevant NATS subjects for a user.
Returns a vector of Dispatcher objects."
[nats sse-ch user conn-state]
(let [user-id (:id user)
community-id (:active-community conn-state)
channel-id (:active-channel conn-state)
handler (fn [event] (route-event sse-ch event user))
subs (atom [])]
;; Community events (messages, channels, reactions, etc.)
(when community-id
(let [d (eventbus/subscribe! nats
(str "chat.events." community-id)
handler)]
(swap! subs conj d)))
;; Typing indicators for the active channel
(when (and community-id channel-id)
(let [d (eventbus/subscribe! nats
(str "chat.typing." community-id "." channel-id)
handler)]
(swap! subs conj d)))
;; Presence updates for the community
(when community-id
(let [d (eventbus/subscribe! nats
(str "chat.presence." community-id)
handler)]
(swap! subs conj d)))
;; Per-user notifications
(when user-id
(let [d (eventbus/subscribe! nats
(str "chat.notifications." user-id)
handler)]
(swap! subs conj d)))
;; DM channels -- subscribe to each DM the user is in
;; We subscribe to a wildcard for DMs since the user could have many
(when user-id
(let [d (eventbus/subscribe! nats
"chat.dm.*"
(fn [event]
;; Filter: only route events for DM channels this user is in
(let [payload (:payload event)
participants (or (:participants payload) (:participant-ids payload) [])]
(when (or (empty? participants)
(some #{(str user-id)} (map str participants)))
(handler event)))))]
(swap! subs conj d)))
@subs))
(defn- unsubscribe-all!
"Unsubscribe from all NATS dispatchers."
[nats dispatchers]
(doseq [d dispatchers]
(try
(eventbus/unsubscribe! nats d)
(catch Exception e
(log/debug "Error unsubscribing NATS dispatcher:" (ex-message e))))))
;;; ---------------------------------------------------------------------------
;;; Connection Lifecycle
;;; ---------------------------------------------------------------------------
(defn- on-sse-connect!
"Handle new SSE connection. Fetch user info, subscribe to NATS, track state."
[connections nats api-url request sse-ch]
(let [headers (:headers request)
user-id (get headers "x-user-id")
ctx (api/request->ctx request api-url)]
(when user-id
(try
(let [user (api/get-me ctx)
communities (api/get-communities ctx)
community (first communities)
community-id (when community (str (:id community)))
channels (when community-id (api/get-channels ctx community-id))
channel (first (filter #(= "text" (name (or (:type %) :text))) channels))
channel-id (when channel (str (:id channel)))
conn-state {:active-community community-id
:active-channel channel-id}
nats-subs (subscribe-user! nats sse-ch user conn-state)]
;; Store connection state
(swap! connections assoc user-id
{:sse-channel sse-ch
:active-community community-id
:active-channel channel-id
:nats-subs nats-subs
:last-seen (Instant/now)
:user user
:api-ctx ctx})
(log/info "SSE connected for user" user-id
"community" community-id "channel" channel-id)
;; Send initial heartbeat / keep-alive comment
(send-sse! sse-ch ": connected\n\n"))
(catch Exception e
(log/error e "Error setting up SSE connection for user" user-id)
(hk/close sse-ch))))))
(defn- on-sse-disconnect!
"Handle SSE disconnection. Unsubscribe from NATS and clean up."
[connections nats request _status]
(let [user-id (get-in request [:headers "x-user-id"])]
(when user-id
(when-let [conn-state (get @connections user-id)]
(unsubscribe-all! nats (:nats-subs conn-state))
(swap! connections dissoc user-id)
(log/info "SSE disconnected for user" user-id)))))
;;; ---------------------------------------------------------------------------
;;; Public API
;;; ---------------------------------------------------------------------------
(defn sse-handler
"Ring handler for GET /sse/events.
Establishes a persistent SSE connection using http-kit's with-channel."
[request]
(let [system (:system request)
nats (:nats system)
connections (:connections system)
api-url (:api-url system)]
(hk/with-channel request ch
;; Set up SSE headers
(hk/send! ch
{:status 200
:headers {"Content-Type" "text/event-stream"
"Cache-Control" "no-cache, no-store, must-revalidate"
"Connection" "keep-alive"
"X-Accel-Buffering" "no"
"Access-Control-Allow-Origin" "*"}}
false)
;; On connection open, set up NATS subscriptions
(on-sse-connect! connections nats api-url request ch)
;; On close, clean up
(hk/on-close ch
(fn [status]
(on-sse-disconnect! connections nats request status))))))
(defn resubscribe!
"Re-subscribe to NATS for a user after navigation (community/channel change).
Called from handlers when the user navigates."
[connections nats user-id new-community-id new-channel-id]
(when-let [conn-state (get @connections user-id)]
(let [sse-ch (:sse-channel conn-state)
user (:user conn-state)
old-subs (:nats-subs conn-state)]
;; Unsubscribe old
(unsubscribe-all! nats old-subs)
;; Re-subscribe with new community/channel
(let [new-state {:active-community new-community-id
:active-channel new-channel-id}
new-subs (subscribe-user! nats sse-ch user new-state)]
;; Update connection state
(swap! connections assoc user-id
(merge conn-state
{:active-community new-community-id
:active-channel new-channel-id
:nats-subs new-subs
:last-seen (Instant/now)}))
(log/info "Re-subscribed user" user-id
"to community" new-community-id "channel" new-channel-id)))))
(defn disconnect-all!
"Disconnect all SSE clients and clean up NATS subscriptions.
Called during server shutdown."
[connections nats]
(doseq [[user-id conn-state] @connections]
(try
(unsubscribe-all! nats (:nats-subs conn-state))
(when-let [ch (:sse-channel conn-state)]
(hk/close ch))
(catch Exception e
(log/debug "Error disconnecting user" user-id ":" (ex-message e)))))
(reset! connections {}))
(defn send-to-user!
"Send a Datastar SSE event directly to a specific user's connection."
[connections user-id event-type data-lines]
(when-let [conn-state (get @connections user-id)]
(when-let [ch (:sse-channel conn-state)]
(send-sse! ch (sse-event event-type data-lines)))))
(defn send-fragment-to-user!
"Send a Hiccup fragment to a specific user."
[connections user-id hiccup-fragment & [{:keys [selector mode] :or {mode "morph"}}]]
(when-let [conn-state (get @connections user-id)]
(when-let [ch (:sse-channel conn-state)]
(send-patch! ch hiccup-fragment {:selector selector :mode mode}))))