1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349 | ;; ported-from: src/app/ui.ts (the message list and the composer)
;;
;; THE CORE SCREEN ON REPLICANT (Phase 5b), and the second file to follow the
;; shape app/lobby.cljs established. What it replaces is worth naming, because
;; the shape below is the answer to it: `render-msg` built ~20 DOM nodes by
;; hand per message, attached nine listeners to each, and interpolated four
;; translated strings into `innerHTML` through a hand-rolled `esc` — 1000
;; messages meant 9000 closures, rebuilt on every frame that touched anything.
;;
;; TWO LAYERS here, and the boundary is the point:
;;
;; `project` the ONE place a JS message object is read. It takes the store's
;; `messages` array plus this session's context and answers with
;; Clojure data: no DOM, no clock beyond the `:time` it formats,
;; nothing that cannot be printed and compared.
;; `view` / state -> hiccup, pure and TOTAL: everything they read is in the
;; `thread-` state they are handed, which is what makes
;; `view` / test/vectors/msgs-view.json a golden vector rather than a
;; `composer` screenshot.
;;
;; Both return a SEQ of nodes, never a vector: `replicant.dom/render` takes
;; "a single hiccup node, or a list of multiple nodes", and a vector whose head
;; is not a keyword is neither — it would be stringified into the page. That is
;; why every builder below ends in `concat`/`map`/`list` and never in `[…]`.
;;
;; THREE THINGS ARE DERIVED AT RENDER, on purpose, because each used to be
;; forty little mutations instead:
;;
;; the authorship badge from ONE `:trust` map keyed by author pub. Ticking
;; "verified" now moves every message's badge on the
;; next frame; it used to mutate the verdict object
;; hanging off the peer's roster entry, which no
;; message ever pointed at, so already-rendered
;; messages kept the old badge until the room reopened.
;; the reaction chip `on` iff `:self-author` is in that emoji's author
;; set. The set is the state; "is it mine" is a
;; question about it.
;; the avatar hue/glyph from `:accents`, falling back to the
;; hash-derived colour of the author key.
;;
;; NO `esc`, and no `.-innerHTML`: hiccup text becomes a DOM text node, so a
;; room label, a display name, a message body and a translated string are all
;; structurally incapable of being markup (test/source-hygiene.test.mjs).
(ns sueta.app.msgs
(:require [sueta.i18n :as i18n :refer (t tn)]
[ardegazu.rooms.js :as j]))
(def EMOJI
"The reaction palette. The hover bar offers the first three; the long-press
action sheet offers all six."
["👍" "❤️" "😂" "😮" "😢" "🔥"])
;; ---- pure helpers ----------------------------------------------------------
(defn color-for
"A stable hue per author key. TS: `h = (h * 31 + c.charCodeAt(0)) >>> 0` —
UNSIGNED 32-bit. `bit-or … 0` would be the signed truncation and give
different hues for half the ids."
[author]
(let [h (volatile! 0)]
(doseq [c (array-seq (.split ^string (js* "String(~{})" author) ""))]
(vreset! h (unsigned-bit-shift-right (+ (* @h 31) (.charCodeAt ^string c 0)) 0)))
(str "hsl(" (mod @h 360) " 45% 40%)")))
(defn- fmt-time [ts]
(i18n/fmt-time (js/Date. ts) (j/ordered "hour" "2-digit" "minute" "2-digit")))
(defn text-runs
"Plain text as hiccup children: bare strings, with every http(s) run lifted
into an `<a>`. No unfurl, nothing is ever fetched. Returns a SEQ (nil for
nothing to say) because these are children, not one node."
[text]
(if (nil? text)
nil
(let [ms (js/Array.from (.matchAll ^string text (js/RegExp. "https?:\\/\\/[^\\s<>\"']+" "g")))]
(seq
(loop [i 0
at 0
out []]
(if (>= i (.-length ms))
(let [tail (.slice ^string text at)]
(cond-> out (pos? (.-length ^string tail)) (conj tail)))
(let [m (aget ms i)
idx (.-index ^js m)
url (aget m 0)
lead (.slice ^string text at idx)]
(recur (inc i)
(+ idx (.-length ^string url))
(conj (cond-> out (pos? (.-length ^string lead)) (conj lead))
[:a {:href url :target "_blank" :rel "noopener noreferrer"} url])))))))))
;; ---- the projection --------------------------------------------------------
;;
;; The JS boundary. Above it a Message is a mutable JS object built by
;; app/chat's MESSAGE shape; below it everything is Clojure data and `nil` is
;; the only absence.
(defn- rx-of
"One message's reactions as ordered pairs. The store holds {emoji #{author}},
whose iteration order is unspecified — so the ORDER is decided here, once,
by the emoji, rather than being whatever a js/Map's insertion history was."
[reactions]
(->> reactions
(map (fn [pair] [(key pair) (vec (sort (val pair)))]))
(sort-by first)
vec))
(defn- img-of [m blobs]
(when-some [img (unchecked-get m "img")]
(let [cid (unchecked-get img "cid")]
{:cid cid
:w (unchecked-get img "w")
:h (unchecked-get img "h")
:bytes (unchecked-get img "bytes")
:received (unchecked-get img "received")
:complete? (true? (unchecked-get img "complete"))
:expired? (true? (unchecked-get img "expired"))
;; a blob URL is a RESOURCE, not message data: it is keyed by CID in
;; app/chat's registry and looked up here, so two messages carrying the
;; same image share one URL and eviction is a set difference
:url (get blobs cid)})))
(defn- row-of [m blobs replies]
{:id (unchecked-get m "id")
:from (unchecked-get m "from")
:name (unchecked-get m "name")
:ts (unchecked-get m "ts")
;; formatted HERE, not in the view: the view stays free of Intl, so its
;; snapshot cannot drift with the platform's locale data
:time (fmt-time (unchecked-get m "ts"))
:text (unchecked-get m "text")
:thread (unchecked-get m "thread")
:mine? (true? (unchecked-get m "mine"))
:img (img-of m blobs)
:rx (rx-of (unchecked-get m "reactions"))
:replies replies})
(defn project
"The store's `messages` array and this session's context, as the value the
view renders.
ctx: {:trust :accents :me-fp :self-author :blobs :host :thread :actions-for
:peers}. Everything the screen shows is a function of it, which is the
whole claim the golden vector rests on.
One O(n) pass builds the id set and the reply tally — both were O(n²) per
render at the 1000-message cap, once per MESSAGE rather than once per pass."
[messages ctx]
(let [{:keys [blobs thread peers]} ctx
all (vec (array-seq messages))
ids (into #{} (map #(unchecked-get % "id")) all)
counts (frequencies (keep #(unchecked-get % "thread") all))
row (fn [m] (row-of m blobs (get counts (unchecked-get m "id") 0)))
roots (into [] (comp (remove (fn [m]
(let [th (unchecked-get m "thread")]
(and (some? th) (contains? ids th)))))
(map row))
all)
open (when (some? thread) (first (filter #(= thread (unchecked-get % "id")) all)))
replies (when (some? thread)
(into [] (comp (filter #(= thread (unchecked-get % "thread"))) (map row)) all))]
(-> (select-keys ctx [:trust :accents :me-fp :self-author :host :actions-for])
(assoc :rows roots
;; the empty-room hint replaced the list only when there was
;; nothing to show AND nobody else in the room
:empty? (and (empty? roots) (identical? 0 peers))
:thread (when (some? thread)
{:id thread
:root (when (some? open) (row open))
:replies replies})))))
;; ---- the view --------------------------------------------------------------
(defn mark
"A fingerprint plus its trust mark, or \"\" while the fingerprint is still
resolving. The TOFU alarm beats the tick: a key that CHANGED is the thing you
have to be told about, even for an identity you once verified.
Public because app/roster derives the same badge from the same two booleans,
and one derivation is the point — the shape this replaced had the roster and
every message each holding their own copy of the verdict."
[fp-emoji verified? key-changed?]
(if (nil? fp-emoji)
""
(str fp-emoji (cond key-changed? "⚠️" verified? "✓" :else ""))))
(defn- badge
"The authorship mark beside a name, derived from the ONE trust map. v2:
authorship is log-entry-signed, so the badge belongs to the author KEY —
`_peers` is keyed by session PeerId and cannot answer this."
[{:keys [from mine?]} trust me-fp]
(if mine?
(if (some? me-fp) me-fp "")
(let [{:keys [fp-emoji verified? key-changed?]} (get trust from)]
(mark fp-emoji verified? key-changed?))))
(defn- avatar-node [{:keys [from name]} accents]
(let [{:keys [hue glyph]} (get accents from)]
[:div.avatar {:style {:background (if (some? hue)
(str "hsl(" hue " 45% 40%)")
(color-for from))}}
(if (some? glyph)
glyph
(.toUpperCase ^string (if-some [c (first name)] (str c) "?")))]))
(defn- img-node [{:keys [cid w h received bytes complete? expired? url]}]
(let [ratio {:aspect-ratio (str w "/" h)}]
(cond
;; complete-with-a-URL wins over expired, exactly as the original's
;; cond did: an attachment can be pruned from the window while its blob
;; is still held, and showing the picture beats showing the tombstone
(and complete? (some? url))
[:div.img-box {:style ratio}
[:img {:src url
:alt (t "msg.image.alt")
:loading "lazy"
:on {:click [:view-image cid]}}]]
;; pruned out of the newest-N window on every device — not a network
;; failure, so no progress bar (the entry with dimensions remains)
expired?
[:div.img-box.expired {:style ratio}
[:div.img-expired (t "msg.image.expired")]]
:else
[:div.img-box.loading {:style ratio}
[:div.img-progress
[:div {:style {:width (str (js/Math.round (* 100 (/ received bytes))) "%")}}]]])))
(defn- chips-node [id rx self-author]
(when (seq rx)
[:div.chips
(map (fn [[emoji by]]
[:button.chip {:replicant/key emoji
:class (when (some #(= % self-author) by) "on")
:on {:click [:react id emoji]}}
(str emoji " " (count by))])
rx)]))
(defn- hoverbar-node [{:keys [id thread]} in-thread?]
[:div.hoverbar
(concat
(map (fn [e] [:button.hb {:replicant/key e :on {:click [:react id e]}} e])
(take 3 EMOJI))
(when-not in-thread?
(list [:button.hb {:replicant/key "reply"
:title (t "msg.reply.title")
:on {:click [:open-thread (if (some? thread) thread id)]}}
"💬"])))])
(defn- actions-node
"The long-press sheet, rendered from state rather than appended to a node —
which is what makes `[id in-thread?]` the whole of its lifetime."
[{:keys [id thread]} in-thread? actions-for]
(when (= actions-for [id in-thread?])
[:div.actions
(concat
(map (fn [e] [:button.ab {:replicant/key e :on {:click [:react-close id e]}} e]) EMOJI)
(when-not in-thread?
(list [:button.ab.reply {:replicant/key "reply"
:on {:click [:reply-close (if (some? thread) thread id)]}}
(t "act.reply")])))]))
(defn- row-node [{:keys [id name text img rx replies mine?] :as row}
{:keys [accents trust me-fp self-author actions-for]}
in-thread?]
[:div.msg {:replicant/key id :class (when mine? "mine")}
(avatar-node row accents)
[:div.msg-body
[:div.msg-meta
[:span.msg-name name]
[:span.msg-id {:title (t "msg.id.title")} (badge row trust me-fp)]
;; NOT destructured above: `time` is a clojure.core MACRO, and a binding
;; named after one shadows it for the whole body with no warning at any
;; optimization level (test/source-hygiene.test.mjs's first check, which
;; caught exactly this line)
[:span.msg-time (:time row)]]
;; the bubble owns the gestures: long-press (touch) and contextmenu both
;; open the action sheet, and the three cancels are what stops a scroll
;; from becoming a long press
[:div.msg-bubble {:on {:contextmenu [:actions id in-thread?]
:touchstart [:press id in-thread?]
:touchend [:press-cancel]
:touchmove [:press-cancel]
:touchcancel [:press-cancel]}}
(text-runs text)
(when (some? img) (img-node img))]
(chips-node id rx self-author)
(when (and (not in-thread?) (pos? replies))
[:button.thread-btn {:on {:click [:open-thread id]}} (tn "msg.replies" replies)])
(hoverbar-node row in-thread?)]
(actions-node row in-thread? actions-for)])
(defn- empty-node [{:keys [host]}]
[:div.empty
[:div.empty-lock "🔒"]
[:p [:strong (t "empty.title")]]
[:p (t "empty.body" {"host" host})]
[:button.primary {:id "empty-invite" :on {:click [:invite]}} (t "empty.invite")]])
(defn view
"state -> the children of `main#msgs`. Pure and total; pinned by
test/vectors/msgs-view.json."
[{:keys [rows empty?] :as state}]
(concat
(when empty? (list (empty-node state)))
(map #(row-node % state false) rows)))
(defn thread-view
"state -> the children of `main#thread-msgs`, or nil when no thread is open.
The root is repeated above the separator, exactly as the panel always did —
a reply reads as a reply to something."
[{:keys [thread] :as state}]
(when (some? thread)
(concat
(when-some [root (:root thread)] (list (row-node root state true)))
(list [:div.thread-sep])
(map #(row-node % state true) (:replies thread)))))
(defn composer
"The composer's children, for the room's or the thread panel's.
AN EXPLICITLY UNCONTROLLED ZONE. There is no `:value` here and there must
never be one: replicant writes `.value` whenever that attribute changes, and
writing it — even the identical string — moves the caret in some browsers.
The textarea's content is the user's; the shell clears it after a send by
hand, on the node, which is the one place that decision belongs.
test/msgs-view.test.mjs asserts the absence, so a future `:value` is a red
test rather than a bug reported as \"typing feels wrong on Android\"."
[thread?]
(list
[:button.icon-btn {:id (if thread? "thread-attach-btn" "attach-btn")
:title (t "composer.photo.title")
:on {:click [:attach thread?]}}
"📷"]
[:textarea {:id (if thread? "thread-input" "input")
:rows "1"
:placeholder (if thread? (t "thread.ph") (t "composer.ph"))
:enterkeyhint "send"
:on {:keydown [:composer-key thread?] :input [:composer-input]}}]
[:button.icon-btn.send {:id (if thread? "thread-send-btn" "send-btn")
:title (t "composer.send.title")
:on {:click [:send thread?]}}
"➤"]
[:input {:id (if thread? "thread-file-in" "file-in")
:type "file"
:accept "image/*"
:hidden "hidden"
:on {:change [:file thread?]}}]))
|