Share who is in the room, and stop Bluesky signing in as somebody else
The membership rules were a hundred lines of `frq.state` and not one of them was desktop: NAMES on the way in, then every JOIN, PART, QUIT, KICK, NICK and MODE, folded into nick -> mode prefix. The server is the one deciding who is in a room and it tells both halves in the same words, so `frq.members` takes the channels map and hands a new one back, and each side swaps it into whatever it keeps that map in. `frq.state` delegates and renders identically — the terminal still says People 3 — and the phone's panel fills for the first time, ops first and then alphabetically, which is the order the shared screen was already asking for. Creating the channel stays with the caller, deliberately. A room means more to the desktop than to the phone — unread counts, read marks, a joining flag — so these only ever touch `:users` and `:names-acc`. Two things fixed on the way in. Someone else's JOIN moved the reader into that channel, because the phone set `current` on every JOIN rather than on its own. And Bluesky signed in as a guest: the guard added with the handshake covered the app-password path only, so the mode that could not sign in fell through to the one that always can, which is the exact failure that guard exists to prevent. Both signed-in modes go through one `sign-in!` now. Bluesky gets as far as it honestly can. A saved broker token is durable and the web-token minted from it is single-use, so a return visit is one POST that `frq.oauth.core` already describes — that works. Getting the first token is the browser handoff, and a phone has nowhere for a loopback to land; it wants an Android app link, which is a decision about what the broker redirects to rather than a porting problem. So it says that instead of connecting as somebody else. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
c6506f2 parent: 8ead4ea added
common/frq/members.cljc +123 -0 | new file mode 100644 | ||
| @@ -0,0 +1,123 @@ | ||
| 1 | +(ns frq.members | |
| 2 | + "Who is in a room, and what the server said to put them there. | |
| 3 | + | |
| 4 | + A channel's `:users` is nick -> mode prefix (\"@\", \"+\", or \"\"). The list is | |
| 5 | + the server's: NAMES on the way in, and every JOIN, PART, QUIT, KICK, NICK | |
| 6 | + and MODE after it. Nothing here asks who is there — being told is what | |
| 7 | + membership is. | |
| 8 | + | |
| 9 | + Every function takes the channels map and returns a new one, which is the | |
| 10 | + only reason this is shared at all: the desktop keeps that map in a glimmer | |
| 11 | + ratom and the phone in an ordinary atom, and neither fact is interesting to | |
| 12 | + the folding. `frq.state` swaps these in; `frq.main` does the same from a | |
| 13 | + Stream. | |
| 14 | + | |
| 15 | + What is deliberately *not* here is creating the channel. A room means more | |
| 16 | + to the desktop than to the phone — unread counts, read marks, a joining | |
| 17 | + flag — so the caller hands in a map that already has the channel in the | |
| 18 | + shape it wants, and these only ever touch `:users` and `:names-acc`." | |
| 19 | + (:require [clojure.string :as str])) | |
| 20 | + | |
| 21 | +(def mode-prefixes | |
| 22 | + "The characters a server puts in front of a nick in NAMES, and in the same | |
| 23 | + order the panel sorts them: owner, admin, op, half-op, voice." | |
| 24 | + "~&@%+") | |
| 25 | + | |
| 26 | +(defn split-prefix | |
| 27 | + "One NAMES entry into `[prefix nick]`. A nick never starts with one of these, | |
| 28 | + so what is in front of it is a mode and not part of the name." | |
| 29 | + [entry] | |
| 30 | + (if (and (seq entry) (str/index-of mode-prefixes (subs entry 0 1))) | |
| 31 | + [(subs entry 0 1) (subs entry 1)] | |
| 32 | + ["" entry])) | |
| 33 | + | |
| 34 | +(defn with-names | |
| 35 | + "One 353 folded into the channel's pending list. | |
| 36 | + | |
| 37 | + Pending rather than live: the reply comes in as many lines as it takes and | |
| 38 | + ends with 366, and replacing `:users` on each of them would empty the panel | |
| 39 | + and refill it a name at a time." | |
| 40 | + [m channel names] | |
| 41 | + (reduce (fn [m entry] | |
| 42 | + (let [[prefix nick] (split-prefix entry)] | |
| 43 | + (assoc-in m [channel :names-acc nick] prefix))) | |
| 44 | + m | |
| 45 | + (remove str/blank? (str/split (or names "") #" ")))) | |
| 46 | + | |
| 47 | +(defn names-done | |
| 48 | + "366: the pending list becomes the list." | |
| 49 | + [m channel] | |
| 50 | + (if-let [acc (get-in m [channel :names-acc])] | |
| 51 | + (-> m | |
| 52 | + (assoc-in [channel :users] acc) | |
| 53 | + (update channel dissoc :names-acc)) | |
| 54 | + m)) | |
| 55 | + | |
| 56 | +(defn add-user [m channel nick] | |
| 57 | + (if (and channel nick) | |
| 58 | + (update-in m [channel :users] (fnil assoc {}) nick "") | |
| 59 | + m)) | |
| 60 | + | |
| 61 | +(defn remove-user [m channel nick] | |
| 62 | + (if (and channel nick (contains? m channel)) | |
| 63 | + (update-in m [channel :users] dissoc nick) | |
| 64 | + m)) | |
| 65 | + | |
| 66 | +(defn remove-everywhere | |
| 67 | + "A QUIT names no channel — the person left the server, so they left every | |
| 68 | + room this client is watching them in." | |
| 69 | + [m nick] | |
| 70 | + (reduce-kv (fn [m k v] (assoc m k (update v :users dissoc nick))) {} m)) | |
| 71 | + | |
| 72 | +(defn rename-user | |
| 73 | + "A NICK, in every channel the old name was in. Their modes come with them: | |
| 74 | + renaming is not leaving." | |
| 75 | + [m old new] | |
| 76 | + (reduce-kv (fn [m k v] | |
| 77 | + (assoc m k | |
| 78 | + (if-let [prefix (get (:users v) old)] | |
| 79 | + (update v :users #(-> % (dissoc old) (assoc new prefix))) | |
| 80 | + v))) | |
| 81 | + {} | |
| 82 | + m)) | |
| 83 | + | |
| 84 | +(defn with-mode | |
| 85 | + "A channel MODE, for the letters that change how someone is listed. | |
| 86 | + | |
| 87 | + `args` is whoever the modes were applied to, in order; anything else in the | |
| 88 | + mode string — a key, a limit, a ban — names no member and is skipped. A mode | |
| 89 | + that takes an argument without naming a member still eats one, and reading | |
| 90 | + the next letter's nick out of the wrong place would put a mode on a | |
| 91 | + stranger, so only the setting form takes one." | |
| 92 | + [m channel modes args] | |
| 93 | + (let [letters {\q "~" \a "&" \o "@" \h "%" \v "+"}] | |
| 94 | + (loop [m m chars (seq modes) args args adding? true] | |
| 95 | + (if-let [c (first chars)] | |
| 96 | + (case c | |
| 97 | + \+ (recur m (rest chars) args true) | |
| 98 | + \- (recur m (rest chars) args false) | |
| 99 | + (if-let [prefix (letters c)] | |
| 100 | + (let [nick (first args)] | |
| 101 | + (recur (if (and nick (get-in m [channel :users nick])) | |
| 102 | + (assoc-in m [channel :users nick] (if adding? prefix "")) | |
| 103 | + m) | |
| 104 | + (rest chars) (rest args) adding?)) | |
| 105 | + (recur m (rest chars) (if adding? (rest args) args) adding?))) | |
| 106 | + m)))) | |
| 107 | + | |
| 108 | +(def ^:private prefix-rank | |
| 109 | + (into {"" (count mode-prefixes)} | |
| 110 | + (map-indexed (fn [i c] [(str c) i]) mode-prefixes))) | |
| 111 | + | |
| 112 | +(defn member-list | |
| 113 | + "Who is in `channel`, as `{:nick :prefix}`, ops first and then alphabetically | |
| 114 | + — the order every other client lists them in, and the one a reader scanning | |
| 115 | + for a name expects." | |
| 116 | + [m channel] | |
| 117 | + (->> (get-in m [channel :users]) | |
| 118 | + (map (fn [[nick prefix]] {:nick nick :prefix prefix})) | |
| 119 | + (sort-by (juxt #(prefix-rank (:prefix %) 99) #(str/lower-case (:nick %)))) | |
| 120 | + vec)) | |
| 121 | + | |
| 122 | +(defn member-count [m channel] | |
| 123 | + (count (get-in m [channel :users]))) | |
| new file mode 100644 | |||
| @@ -0,0 +1,123 @@ | |||
| 1 | +(ns frq.members | ||
| 2 | + "Who is in a room, and what the server said to put them there. | ||
| 3 | + | ||
| 4 | + A channel's `:users` is nick -> mode prefix (\"@\", \"+\", or \"\"). The list is | ||
| 5 | + the server's: NAMES on the way in, and every JOIN, PART, QUIT, KICK, NICK | ||
| 6 | + and MODE after it. Nothing here asks who is there — being told is what | ||
| 7 | + membership is. | ||
| 8 | + | ||
| 9 | + Every function takes the channels map and returns a new one, which is the | ||
| 10 | + only reason this is shared at all: the desktop keeps that map in a glimmer | ||
| 11 | + ratom and the phone in an ordinary atom, and neither fact is interesting to | ||
| 12 | + the folding. `frq.state` swaps these in; `frq.main` does the same from a | ||
| 13 | + Stream. | ||
| 14 | + | ||
| 15 | + What is deliberately *not* here is creating the channel. A room means more | ||
| 16 | + to the desktop than to the phone — unread counts, read marks, a joining | ||
| 17 | + flag — so the caller hands in a map that already has the channel in the | ||
| 18 | + shape it wants, and these only ever touch `:users` and `:names-acc`." | ||
| 19 | + (:require [clojure.string :as str])) | ||
| 20 | + | ||
| 21 | +(def mode-prefixes | ||
| 22 | + "The characters a server puts in front of a nick in NAMES, and in the same | ||
| 23 | + order the panel sorts them: owner, admin, op, half-op, voice." | ||
| 24 | + "~&@%+") | ||
| 25 | + | ||
| 26 | +(defn split-prefix | ||
| 27 | + "One NAMES entry into `[prefix nick]`. A nick never starts with one of these, | ||
| 28 | + so what is in front of it is a mode and not part of the name." | ||
| 29 | + [entry] | ||
| 30 | + (if (and (seq entry) (str/index-of mode-prefixes (subs entry 0 1))) | ||
| 31 | + [(subs entry 0 1) (subs entry 1)] | ||
| 32 | + ["" entry])) | ||
| 33 | + | ||
| 34 | +(defn with-names | ||
| 35 | + "One 353 folded into the channel's pending list. | ||
| 36 | + | ||
| 37 | + Pending rather than live: the reply comes in as many lines as it takes and | ||
| 38 | + ends with 366, and replacing `:users` on each of them would empty the panel | ||
| 39 | + and refill it a name at a time." | ||
| 40 | + [m channel names] | ||
| 41 | + (reduce (fn [m entry] | ||
| 42 | + (let [[prefix nick] (split-prefix entry)] | ||
| 43 | + (assoc-in m [channel :names-acc nick] prefix))) | ||
| 44 | + m | ||
| 45 | + (remove str/blank? (str/split (or names "") #" ")))) | ||
| 46 | + | ||
| 47 | +(defn names-done | ||
| 48 | + "366: the pending list becomes the list." | ||
| 49 | + [m channel] | ||
| 50 | + (if-let [acc (get-in m [channel :names-acc])] | ||
| 51 | + (-> m | ||
| 52 | + (assoc-in [channel :users] acc) | ||
| 53 | + (update channel dissoc :names-acc)) | ||
| 54 | + m)) | ||
| 55 | + | ||
| 56 | +(defn add-user [m channel nick] | ||
| 57 | + (if (and channel nick) | ||
| 58 | + (update-in m [channel :users] (fnil assoc {}) nick "") | ||
| 59 | + m)) | ||
| 60 | + | ||
| 61 | +(defn remove-user [m channel nick] | ||
| 62 | + (if (and channel nick (contains? m channel)) | ||
| 63 | + (update-in m [channel :users] dissoc nick) | ||
| 64 | + m)) | ||
| 65 | + | ||
| 66 | +(defn remove-everywhere | ||
| 67 | + "A QUIT names no channel — the person left the server, so they left every | ||
| 68 | + room this client is watching them in." | ||
| 69 | + [m nick] | ||
| 70 | + (reduce-kv (fn [m k v] (assoc m k (update v :users dissoc nick))) {} m)) | ||
| 71 | + | ||
| 72 | +(defn rename-user | ||
| 73 | + "A NICK, in every channel the old name was in. Their modes come with them: | ||
| 74 | + renaming is not leaving." | ||
| 75 | + [m old new] | ||
| 76 | + (reduce-kv (fn [m k v] | ||
| 77 | + (assoc m k | ||
| 78 | + (if-let [prefix (get (:users v) old)] | ||
| 79 | + (update v :users #(-> % (dissoc old) (assoc new prefix))) | ||
| 80 | + v))) | ||
| 81 | + {} | ||
| 82 | + m)) | ||
| 83 | + | ||
| 84 | +(defn with-mode | ||
| 85 | + "A channel MODE, for the letters that change how someone is listed. | ||
| 86 | + | ||
| 87 | + `args` is whoever the modes were applied to, in order; anything else in the | ||
| 88 | + mode string — a key, a limit, a ban — names no member and is skipped. A mode | ||
| 89 | + that takes an argument without naming a member still eats one, and reading | ||
| 90 | + the next letter's nick out of the wrong place would put a mode on a | ||
| 91 | + stranger, so only the setting form takes one." | ||
| 92 | + [m channel modes args] | ||
| 93 | + (let [letters {\q "~" \a "&" \o "@" \h "%" \v "+"}] | ||
| 94 | + (loop [m m chars (seq modes) args args adding? true] | ||
| 95 | + (if-let [c (first chars)] | ||
| 96 | + (case c | ||
| 97 | + \+ (recur m (rest chars) args true) | ||
| 98 | + \- (recur m (rest chars) args false) | ||
| 99 | + (if-let [prefix (letters c)] | ||
| 100 | + (let [nick (first args)] | ||
| 101 | + (recur (if (and nick (get-in m [channel :users nick])) | ||
| 102 | + (assoc-in m [channel :users nick] (if adding? prefix "")) | ||
| 103 | + m) | ||
| 104 | + (rest chars) (rest args) adding?)) | ||
| 105 | + (recur m (rest chars) (if adding? (rest args) args) adding?))) | ||
| 106 | + m)))) | ||
| 107 | + | ||
| 108 | +(def ^:private prefix-rank | ||
| 109 | + (into {"" (count mode-prefixes)} | ||
| 110 | + (map-indexed (fn [i c] [(str c) i]) mode-prefixes))) | ||
| 111 | + | ||
| 112 | +(defn member-list | ||
| 113 | + "Who is in `channel`, as `{:nick :prefix}`, ops first and then alphabetically | ||
| 114 | + — the order every other client lists them in, and the one a reader scanning | ||
| 115 | + for a name expects." | ||
| 116 | + [m channel] | ||
| 117 | + (->> (get-in m [channel :users]) | ||
| 118 | + (map (fn [[nick prefix]] {:nick nick :prefix prefix})) | ||
| 119 | + (sort-by (juxt #(prefix-rank (:prefix %) 99) #(str/lower-case (:nick %)))) | ||
| 120 | + vec)) | ||
| 121 | + | ||
| 122 | +(defn member-count [m channel] | ||
| 123 | + (count (get-in m [channel :users]))) | ||
modified
flutter/src/frq/main.cljd +115 -38 | @@ -36,6 +36,8 @@ | ||
| 36 | 36 | [frq.screens.settings :as settings] |
| 37 | 37 | [frq.screens.app :as screens] |
| 38 | 38 | [frq.rooms :as rooms] |
| 39 | + [frq.members :as members] | |
| 40 | + [frq.oauth.core :as oauth] | |
| 39 | 41 | [frq.irc.parse :as irc] |
| 40 | 42 | [frq.irc.handshake :as handshake])) |
| 41 | 43 | |
| @@ -46,18 +48,59 @@ | ||
| 46 | 48 | |
| 47 | 49 | (defn- room! |
| 48 | 50 | "The little of `frq.state/apply-msg!` the conversation list needs: the two |
| 49 | - messages that make a room appear and give it a last line." | |
| 51 | + messages that make a room appear and give it a last line, and everything | |
| 52 | + that says who is in it. | |
| 53 | + | |
| 54 | + The membership half is `frq.members`, unchanged from what the desktop folds | |
| 55 | + — the server is the one deciding who is in a room, and it tells both halves | |
| 56 | + in the same words." | |
| 50 | 57 | [m] |
| 51 | 58 | (let [cmd (str (:command m)) |
| 52 | 59 | params (vec (:params m)) |
| 53 | - who (irc/nick-of (:prefix m))] | |
| 60 | + who (irc/nick-of (:prefix m)) | |
| 61 | + me? (= who (str @cells/form-nick)) | |
| 62 | + ensure (fn [m name] (update m name #(merge {:name name :messages [] :unread 0} %)))] | |
| 54 | 63 | (cond |
| 55 | 64 | (= "JOIN" cmd) |
| 56 | 65 | (let [name (first params)] |
| 57 | - (swap! cells/channels update name | |
| 58 | - #(merge {:name name :messages [] :unread 0} % | |
| 59 | - {:joined? true :accessed (clock/now-ms)})) | |
| 60 | - (reset! cells/current name)) | |
| 66 | + (swap! cells/channels | |
| 67 | + #(-> (ensure % name) | |
| 68 | + (members/add-user name who) | |
| 69 | + (cond-> me? (update name merge {:joined? true | |
| 70 | + :accessed (clock/now-ms)})))) | |
| 71 | + ;; Only our own JOIN opens the room. Someone else arriving in a | |
| 72 | + ;; channel used to move the reader into it. | |
| 73 | + (when me? (reset! cells/current name))) | |
| 74 | + | |
| 75 | + ;; 353 is the roll, in as many lines as it takes; 366 ends it. | |
| 76 | + (= "353" cmd) | |
| 77 | + (let [name (nth params 2 nil)] | |
| 78 | + (when name | |
| 79 | + (swap! cells/channels #(members/with-names (ensure % name) name (last params))))) | |
| 80 | + | |
| 81 | + (= "366" cmd) | |
| 82 | + (let [name (nth params 1 nil)] | |
| 83 | + (when name (swap! cells/channels members/names-done name))) | |
| 84 | + | |
| 85 | + (= "PART" cmd) | |
| 86 | + (swap! cells/channels members/remove-user (first params) who) | |
| 87 | + | |
| 88 | + (= "KICK" cmd) | |
| 89 | + (swap! cells/channels members/remove-user (first params) (nth params 1 nil)) | |
| 90 | + | |
| 91 | + (= "QUIT" cmd) | |
| 92 | + (swap! cells/channels members/remove-everywhere who) | |
| 93 | + | |
| 94 | + (= "NICK" cmd) | |
| 95 | + (do (swap! cells/channels members/rename-user who (last params)) | |
| 96 | + ;; Our own rename is the server settling what we are called — it | |
| 97 | + ;; hands a guest a name of its choosing, so this is the usual way | |
| 98 | + ;; the nick on screen becomes the real one. | |
| 99 | + (when me? (reset! cells/form-nick (last params)))) | |
| 100 | + | |
| 101 | + (= "MODE" cmd) | |
| 102 | + (swap! cells/channels members/with-mode | |
| 103 | + (first params) (nth params 1 "") (drop 2 params)) | |
| 61 | 104 | |
| 62 | 105 | (= "PRIVMSG" cmd) |
| 63 | 106 | (let [target (first params) |
| @@ -128,6 +171,63 @@ | ||
| 128 | 171 | (reset! cells/screen :connect) |
| 129 | 172 | (reset! cells/error why)) |
| 130 | 173 | |
| 174 | +(defn ^:async bluesky-session! | |
| 175 | + "A web-token session from freeq's auth broker. | |
| 176 | + | |
| 177 | + Only the half that needs no browser. A saved broker token is durable and the | |
| 178 | + web-token minted from it is single-use, so a return visit is one POST to | |
| 179 | + /session and `frq.oauth.core` already says what to send and what the answer | |
| 180 | + means. Getting the *first* broker token is the other half: the browser hands | |
| 181 | + it back to a loopback listener on the desktop, and a phone has nowhere for | |
| 182 | + that to land — it wants an Android app link, which is a decision about what | |
| 183 | + the broker will redirect to and not a porting problem. So that case says so | |
| 184 | + rather than quietly connecting as somebody else." | |
| 185 | + [] | |
| 186 | + (if-let [bt @cells/broker-token] | |
| 187 | + (do | |
| 188 | + (reset! cells/status "Resuming your session…") | |
| 189 | + (let [tokens (oauth/refresh-session-parse | |
| 190 | + bt | |
| 191 | + (await (atproto/fetch | |
| 192 | + (oauth/refresh-session-req oauth/default-broker bt))))] | |
| 193 | + (reset! cells/broker-token (:broker-token tokens)) | |
| 194 | + ;; On every sign-in and not only the first: /session can hand back a | |
| 195 | + ;; rotated broker token, and the old one may stop working the moment | |
| 196 | + ;; it does. | |
| 197 | + (store/save-session! tokens) | |
| 198 | + (assoc tokens :kind :web-token))) | |
| 199 | + (throw (ex-info (str "Bluesky sign-in opens a browser, which the phone " | |
| 200 | + "cannot catch the answer to yet — sign in with an " | |
| 201 | + "app password instead") | |
| 202 | + {})))) | |
| 203 | + | |
| 204 | +(defn ^:async sign-in! | |
| 205 | + "Fill `cells/session` for the mode that was chosen, or say why not. | |
| 206 | + | |
| 207 | + True when the connection may go ahead. A guest carries no session, and must | |
| 208 | + not carry the last one either: a leftover would have `frq.irc.handshake` ask | |
| 209 | + for sasl and authenticate as whoever signed in before." | |
| 210 | + [] | |
| 211 | + (case @cells/auth-mode | |
| 212 | + :guest (do (reset! cells/session nil) true) | |
| 213 | + (try | |
| 214 | + (reset! cells/connecting? true) | |
| 215 | + (reset! cells/error nil) | |
| 216 | + (reset! cells/session | |
| 217 | + (await (if (= :bluesky @cells/auth-mode) | |
| 218 | + (bluesky-session!) | |
| 219 | + (do (reset! cells/status "Signing in…") | |
| 220 | + (atproto/create-session @cells/form-handle | |
| 221 | + @cells/form-app-password))))) | |
| 222 | + true | |
| 223 | + (catch Object e | |
| 224 | + (reset! cells/session nil) | |
| 225 | + ;; The message, not the exception: `frq.atproto.core` puts the body it | |
| 226 | + ;; could not read in the ex-data, and a PDS that answers a resolve with | |
| 227 | + ;; an HTML error page puts the whole page there. | |
| 228 | + (fail! (str "Sign-in failed: " (or (ex-message e) e))) | |
| 229 | + false)))) | |
| 230 | + | |
| 131 | 231 | (defn ^:async connect! |
| 132 | 232 | "What `frq.actions/connect!` is on the phone. |
| 133 | 233 | |
| @@ -146,36 +246,13 @@ | ||
| 146 | 246 | (reset! closing? true) |
| 147 | 247 | (net/close! c) |
| 148 | 248 | (reset! conn nil)) |
| 149 | - ;; A guest carries no session, and must not carry the last one either: a | |
| 150 | - ;; leftover session would have `handshake/step` ask for sasl and then | |
| 151 | - ;; authenticate as whoever signed in before. | |
| 152 | - (when (= :guest @cells/auth-mode) | |
| 153 | - (reset! cells/session nil)) | |
| 154 | - ;; An app password signs in before the socket opens: the SASL payload is | |
| 155 | - ;; built from a PDS session, and getting one is an HTTPS round trip that has | |
| 156 | - ;; nothing to do with IRC. `frq.atproto.core` says what to ask and what the | |
| 157 | - ;; answer means; `frq.atproto.dart` waits for it. Nothing dials out if it | |
| 158 | - ;; fails — connecting anyway would land us on the server as a guest, which | |
| 159 | - ;; looks like a success and is not the one that was asked for. | |
| 160 | - (when | |
| 161 | - (if (= :app-password @cells/auth-mode) | |
| 162 | - (do (reset! cells/connecting? true) | |
| 163 | - (reset! cells/error nil) | |
| 164 | - (reset! cells/status "Signing in…") | |
| 165 | - (try | |
| 166 | - (reset! cells/session | |
| 167 | - (await (atproto/create-session @cells/form-handle | |
| 168 | - @cells/form-app-password))) | |
| 169 | - true | |
| 170 | - (catch Object e | |
| 171 | - (reset! cells/session nil) | |
| 172 | - ;; The message, not the exception: `frq.atproto.core` puts the | |
| 173 | - ;; body it could not read in the ex-data, and a PDS that answers | |
| 174 | - ;; a resolve with an HTML error page puts the whole page there. | |
| 175 | - (fail! (str "Sign-in failed: " (or (ex-message e) e))) | |
| 176 | - false))) | |
| 177 | - true) | |
| 178 | - (let [n (swap! attempt inc)] | |
| 249 | + ;; Whatever identity was asked for, settled before the socket opens. Both | |
| 250 | + ;; of the signed-in modes are an HTTPS round trip that has nothing to do | |
| 251 | + ;; with IRC, and a failure in either must stop here: connecting anyway lands | |
| 252 | + ;; us on the server as a guest, which looks like a success and is not the | |
| 253 | + ;; one that was asked for. Bluesky did exactly that until it was asked. | |
| 254 | + (when (await (sign-in!)) | |
| 255 | + (let [n (swap! attempt inc)] | |
| 179 | 256 | (reset! caps #{}) |
| 180 | 257 | (reset! cells/connecting? true) |
| 181 | 258 | (reset! cells/error nil) |
| @@ -361,8 +438,8 @@ | ||
| 361 | 438 | (->> (get-in @cells/channels [room :messages]) |
| 362 | 439 | (filter #(= id (:id %))) |
| 363 | 440 | first)) |
| 364 | - :member-count (fn [_] nil) | |
| 365 | - :member-list (fn [_] []) | |
| 441 | + :member-count (fn [room] (members/member-count @cells/channels room)) | |
| 442 | + :member-list (fn [room] (members/member-list @cells/channels room)) | |
| 366 | 443 | :toggle-users! (fn [] (swap! cells/show-users? not)) |
| 367 | 444 | :toggle-overview! (fn [] (swap! cells/overview? not)) |
| 368 | 445 | :toggle-chat-list! (fn [] (swap! cells/hide-chat-list? not)) |
| @@ -36,6 +36,8 @@ | |||
| 36 | [frq.screens.settings :as settings] | 36 | [frq.screens.settings :as settings] |
| 37 | [frq.screens.app :as screens] | 37 | [frq.screens.app :as screens] |
| 38 | [frq.rooms :as rooms] | 38 | [frq.rooms :as rooms] |
| 39 | + [frq.members :as members] | ||
| 40 | + [frq.oauth.core :as oauth] | ||
| 39 | [frq.irc.parse :as irc] | 41 | [frq.irc.parse :as irc] |
| 40 | [frq.irc.handshake :as handshake])) | 42 | [frq.irc.handshake :as handshake])) |
| 41 | 43 | ||
| @@ -46,18 +48,59 @@ | |||
| 46 | 48 | ||
| 47 | (defn- room! | 49 | (defn- room! |
| 48 | "The little of `frq.state/apply-msg!` the conversation list needs: the two | 50 | "The little of `frq.state/apply-msg!` the conversation list needs: the two |
| 49 | - messages that make a room appear and give it a last line." | 51 | + messages that make a room appear and give it a last line, and everything |
| 52 | + that says who is in it. | ||
| 53 | + | ||
| 54 | + The membership half is `frq.members`, unchanged from what the desktop folds | ||
| 55 | + — the server is the one deciding who is in a room, and it tells both halves | ||
| 56 | + in the same words." | ||
| 50 | [m] | 57 | [m] |
| 51 | (let [cmd (str (:command m)) | 58 | (let [cmd (str (:command m)) |
| 52 | params (vec (:params m)) | 59 | params (vec (:params m)) |
| 53 | - who (irc/nick-of (:prefix m))] | 60 | + who (irc/nick-of (:prefix m)) |
| 61 | + me? (= who (str @cells/form-nick)) | ||
| 62 | + ensure (fn [m name] (update m name #(merge {:name name :messages [] :unread 0} %)))] | ||
| 54 | (cond | 63 | (cond |
| 55 | (= "JOIN" cmd) | 64 | (= "JOIN" cmd) |
| 56 | (let [name (first params)] | 65 | (let [name (first params)] |
| 57 | - (swap! cells/channels update name | 66 | + (swap! cells/channels |
| 58 | - #(merge {:name name :messages [] :unread 0} % | 67 | + #(-> (ensure % name) |
| 59 | - {:joined? true :accessed (clock/now-ms)})) | 68 | + (members/add-user name who) |
| 60 | - (reset! cells/current name)) | 69 | + (cond-> me? (update name merge {:joined? true |
| 70 | + :accessed (clock/now-ms)})))) | ||
| 71 | + ;; Only our own JOIN opens the room. Someone else arriving in a | ||
| 72 | + ;; channel used to move the reader into it. | ||
| 73 | + (when me? (reset! cells/current name))) | ||
| 74 | + | ||
| 75 | + ;; 353 is the roll, in as many lines as it takes; 366 ends it. | ||
| 76 | + (= "353" cmd) | ||
| 77 | + (let [name (nth params 2 nil)] | ||
| 78 | + (when name | ||
| 79 | + (swap! cells/channels #(members/with-names (ensure % name) name (last params))))) | ||
| 80 | + | ||
| 81 | + (= "366" cmd) | ||
| 82 | + (let [name (nth params 1 nil)] | ||
| 83 | + (when name (swap! cells/channels members/names-done name))) | ||
| 84 | + | ||
| 85 | + (= "PART" cmd) | ||
| 86 | + (swap! cells/channels members/remove-user (first params) who) | ||
| 87 | + | ||
| 88 | + (= "KICK" cmd) | ||
| 89 | + (swap! cells/channels members/remove-user (first params) (nth params 1 nil)) | ||
| 90 | + | ||
| 91 | + (= "QUIT" cmd) | ||
| 92 | + (swap! cells/channels members/remove-everywhere who) | ||
| 93 | + | ||
| 94 | + (= "NICK" cmd) | ||
| 95 | + (do (swap! cells/channels members/rename-user who (last params)) | ||
| 96 | + ;; Our own rename is the server settling what we are called — it | ||
| 97 | + ;; hands a guest a name of its choosing, so this is the usual way | ||
| 98 | + ;; the nick on screen becomes the real one. | ||
| 99 | + (when me? (reset! cells/form-nick (last params)))) | ||
| 100 | + | ||
| 101 | + (= "MODE" cmd) | ||
| 102 | + (swap! cells/channels members/with-mode | ||
| 103 | + (first params) (nth params 1 "") (drop 2 params)) | ||
| 61 | 104 | ||
| 62 | (= "PRIVMSG" cmd) | 105 | (= "PRIVMSG" cmd) |
| 63 | (let [target (first params) | 106 | (let [target (first params) |
| @@ -128,6 +171,63 @@ | |||
| 128 | (reset! cells/screen :connect) | 171 | (reset! cells/screen :connect) |
| 129 | (reset! cells/error why)) | 172 | (reset! cells/error why)) |
| 130 | 173 | ||
| 174 | +(defn ^:async bluesky-session! | ||
| 175 | + "A web-token session from freeq's auth broker. | ||
| 176 | + | ||
| 177 | + Only the half that needs no browser. A saved broker token is durable and the | ||
| 178 | + web-token minted from it is single-use, so a return visit is one POST to | ||
| 179 | + /session and `frq.oauth.core` already says what to send and what the answer | ||
| 180 | + means. Getting the *first* broker token is the other half: the browser hands | ||
| 181 | + it back to a loopback listener on the desktop, and a phone has nowhere for | ||
| 182 | + that to land — it wants an Android app link, which is a decision about what | ||
| 183 | + the broker will redirect to and not a porting problem. So that case says so | ||
| 184 | + rather than quietly connecting as somebody else." | ||
| 185 | + [] | ||
| 186 | + (if-let [bt @cells/broker-token] | ||
| 187 | + (do | ||
| 188 | + (reset! cells/status "Resuming your session…") | ||
| 189 | + (let [tokens (oauth/refresh-session-parse | ||
| 190 | + bt | ||
| 191 | + (await (atproto/fetch | ||
| 192 | + (oauth/refresh-session-req oauth/default-broker bt))))] | ||
| 193 | + (reset! cells/broker-token (:broker-token tokens)) | ||
| 194 | + ;; On every sign-in and not only the first: /session can hand back a | ||
| 195 | + ;; rotated broker token, and the old one may stop working the moment | ||
| 196 | + ;; it does. | ||
| 197 | + (store/save-session! tokens) | ||
| 198 | + (assoc tokens :kind :web-token))) | ||
| 199 | + (throw (ex-info (str "Bluesky sign-in opens a browser, which the phone " | ||
| 200 | + "cannot catch the answer to yet — sign in with an " | ||
| 201 | + "app password instead") | ||
| 202 | + {})))) | ||
| 203 | + | ||
| 204 | +(defn ^:async sign-in! | ||
| 205 | + "Fill `cells/session` for the mode that was chosen, or say why not. | ||
| 206 | + | ||
| 207 | + True when the connection may go ahead. A guest carries no session, and must | ||
| 208 | + not carry the last one either: a leftover would have `frq.irc.handshake` ask | ||
| 209 | + for sasl and authenticate as whoever signed in before." | ||
| 210 | + [] | ||
| 211 | + (case @cells/auth-mode | ||
| 212 | + :guest (do (reset! cells/session nil) true) | ||
| 213 | + (try | ||
| 214 | + (reset! cells/connecting? true) | ||
| 215 | + (reset! cells/error nil) | ||
| 216 | + (reset! cells/session | ||
| 217 | + (await (if (= :bluesky @cells/auth-mode) | ||
| 218 | + (bluesky-session!) | ||
| 219 | + (do (reset! cells/status "Signing in…") | ||
| 220 | + (atproto/create-session @cells/form-handle | ||
| 221 | + @cells/form-app-password))))) | ||
| 222 | + true | ||
| 223 | + (catch Object e | ||
| 224 | + (reset! cells/session nil) | ||
| 225 | + ;; The message, not the exception: `frq.atproto.core` puts the body it | ||
| 226 | + ;; could not read in the ex-data, and a PDS that answers a resolve with | ||
| 227 | + ;; an HTML error page puts the whole page there. | ||
| 228 | + (fail! (str "Sign-in failed: " (or (ex-message e) e))) | ||
| 229 | + false)))) | ||
| 230 | + | ||
| 131 | (defn ^:async connect! | 231 | (defn ^:async connect! |
| 132 | "What `frq.actions/connect!` is on the phone. | 232 | "What `frq.actions/connect!` is on the phone. |
| 133 | 233 | ||
| @@ -146,36 +246,13 @@ | |||
| 146 | (reset! closing? true) | 246 | (reset! closing? true) |
| 147 | (net/close! c) | 247 | (net/close! c) |
| 148 | (reset! conn nil)) | 248 | (reset! conn nil)) |
| 149 | - ;; A guest carries no session, and must not carry the last one either: a | 249 | + ;; Whatever identity was asked for, settled before the socket opens. Both |
| 150 | - ;; leftover session would have `handshake/step` ask for sasl and then | 250 | + ;; of the signed-in modes are an HTTPS round trip that has nothing to do |
| 151 | - ;; authenticate as whoever signed in before. | 251 | + ;; with IRC, and a failure in either must stop here: connecting anyway lands |
| 152 | - (when (= :guest @cells/auth-mode) | 252 | + ;; us on the server as a guest, which looks like a success and is not the |
| 153 | - (reset! cells/session nil)) | 253 | + ;; one that was asked for. Bluesky did exactly that until it was asked. |
| 154 | - ;; An app password signs in before the socket opens: the SASL payload is | 254 | + (when (await (sign-in!)) |
| 155 | - ;; built from a PDS session, and getting one is an HTTPS round trip that has | 255 | + (let [n (swap! attempt inc)] |
| 156 | - ;; nothing to do with IRC. `frq.atproto.core` says what to ask and what the | ||
| 157 | - ;; answer means; `frq.atproto.dart` waits for it. Nothing dials out if it | ||
| 158 | - ;; fails — connecting anyway would land us on the server as a guest, which | ||
| 159 | - ;; looks like a success and is not the one that was asked for. | ||
| 160 | - (when | ||
| 161 | - (if (= :app-password @cells/auth-mode) | ||
| 162 | - (do (reset! cells/connecting? true) | ||
| 163 | - (reset! cells/error nil) | ||
| 164 | - (reset! cells/status "Signing in…") | ||
| 165 | - (try | ||
| 166 | - (reset! cells/session | ||
| 167 | - (await (atproto/create-session @cells/form-handle | ||
| 168 | - @cells/form-app-password))) | ||
| 169 | - true | ||
| 170 | - (catch Object e | ||
| 171 | - (reset! cells/session nil) | ||
| 172 | - ;; The message, not the exception: `frq.atproto.core` puts the | ||
| 173 | - ;; body it could not read in the ex-data, and a PDS that answers | ||
| 174 | - ;; a resolve with an HTML error page puts the whole page there. | ||
| 175 | - (fail! (str "Sign-in failed: " (or (ex-message e) e))) | ||
| 176 | - false))) | ||
| 177 | - true) | ||
| 178 | - (let [n (swap! attempt inc)] | ||
| 179 | (reset! caps #{}) | 256 | (reset! caps #{}) |
| 180 | (reset! cells/connecting? true) | 257 | (reset! cells/connecting? true) |
| 181 | (reset! cells/error nil) | 258 | (reset! cells/error nil) |
| @@ -361,8 +438,8 @@ | |||
| 361 | (->> (get-in @cells/channels [room :messages]) | 438 | (->> (get-in @cells/channels [room :messages]) |
| 362 | (filter #(= id (:id %))) | 439 | (filter #(= id (:id %))) |
| 363 | first)) | 440 | first)) |
| 364 | - :member-count (fn [_] nil) | 441 | + :member-count (fn [room] (members/member-count @cells/channels room)) |
| 365 | - :member-list (fn [_] []) | 442 | + :member-list (fn [room] (members/member-list @cells/channels room)) |
| 366 | :toggle-users! (fn [] (swap! cells/show-users? not)) | 443 | :toggle-users! (fn [] (swap! cells/show-users? not)) |
| 367 | :toggle-overview! (fn [] (swap! cells/overview? not)) | 444 | :toggle-overview! (fn [] (swap! cells/overview? not)) |
| 368 | :toggle-chat-list! (fn [] (swap! cells/hide-chat-list? not)) | 445 | :toggle-chat-list! (fn [] (swap! cells/hide-chat-list? not)) |
modified
src/frq/state.clj +26 -106 | @@ -6,6 +6,7 @@ | ||
| 6 | 6 | is the only place a wire message turns into UI state." |
| 7 | 7 | (:require [clojure.string :as str] |
| 8 | 8 | [frq.rooms :as rooms] |
| 9 | + [frq.members :as members] | |
| 9 | 10 | [glimmer.ratom :as r :refer [atom]] |
| 10 | 11 | [frq.actions :as actions] |
| 11 | 12 | [frq.cells :as cells] |
| @@ -642,120 +643,39 @@ | ||
| 642 | 643 | (or @found? :absent)))) |
| 643 | 644 | |
| 644 | 645 | ;; --- who is in the room ------------------------------------------------------ |
| 645 | -;; A channel's `:users` is nick -> mode prefix ("@", "+", or ""). The list is | |
| 646 | -;; the server's: NAMES on the way in, and every JOIN, PART, QUIT, KICK and NICK | |
| 647 | -;; after it. Nothing here asks who is there — being told is what membership is. | |
| 648 | - | |
| 649 | -(def ^:private mode-prefixes | |
| 650 | - "The characters a server puts in front of a nick in NAMES, and in the same | |
| 651 | - order the panel sorts them: owner, admin, op, half-op, voice." | |
| 652 | - "~&@%+") | |
| 653 | - | |
| 654 | -(defn- split-prefix | |
| 655 | - "One NAMES entry into `[prefix nick]`. A nick never starts with one of these, | |
| 656 | - so what is in front of it is a mode and not part of the name." | |
| 657 | - [entry] | |
| 658 | - (if (and (seq entry) (str/index-of mode-prefixes (subs entry 0 1))) | |
| 659 | - [(subs entry 0 1) (subs entry 1)] | |
| 660 | - ["" entry])) | |
| 661 | - | |
| 662 | -(defn- names-line | |
| 663 | - "Fold one 353 into the channel's pending list. Pending rather than live: the | |
| 664 | - reply comes in as many lines as it takes and ends with 366, and replacing | |
| 665 | - `:users` on each of them would empty the panel and refill it a name at a | |
| 666 | - time." | |
| 667 | - [channel names] | |
| 668 | - (swap! channels | |
| 669 | - (fn [m] | |
| 670 | - (reduce (fn [m entry] | |
| 671 | - (let [[prefix nick] (split-prefix entry)] | |
| 672 | - (assoc-in m [channel :names-acc nick] prefix))) | |
| 673 | - (ensure-channel m channel) | |
| 674 | - (remove str/blank? (str/split (or names "") #" ")))))) | |
| 675 | - | |
| 676 | -(defn- names-end! | |
| 677 | - "366: the pending list becomes the list." | |
| 678 | - [channel] | |
| 679 | - (swap! channels | |
| 680 | - (fn [m] | |
| 681 | - (if-let [acc (get-in m [channel :names-acc])] | |
| 682 | - (-> m (assoc-in [channel :users] acc) | |
| 683 | - (update channel dissoc :names-acc)) | |
| 684 | - m)))) | |
| 646 | +;; All of it is `frq.members` now: a fold over the channels map, which is the | |
| 647 | +;; same fold under either compiler. What stays here is the atom it is folded | |
| 648 | +;; into and `ensure-channel`, because a room means more to this half than to | |
| 649 | +;; the phone — unread counts, read marks, a joining flag — and the shared | |
| 650 | +;; functions deliberately only ever touch `:users` and `:names-acc`. | |
| 651 | + | |
| 652 | +(defn- names-line [channel names] | |
| 653 | + (swap! channels #(members/with-names (ensure-channel % channel) channel names))) | |
| 654 | + | |
| 655 | +(defn- names-end! [channel] | |
| 656 | + (swap! channels members/names-done channel)) | |
| 685 | 657 | |
| 686 | 658 | (defn- add-user! [channel nick] |
| 687 | 659 | (when (and channel nick) |
| 688 | - (swap! channels #(-> (ensure-channel % channel) | |
| 689 | - (update-in [channel :users] (fnil assoc {}) nick ""))))) | |
| 660 | + (swap! channels #(members/add-user (ensure-channel % channel) channel nick)))) | |
| 690 | 661 | |
| 691 | 662 | (defn- remove-user! [channel nick] |
| 692 | - (when (and channel nick) | |
| 693 | - (swap! channels #(if (contains? % channel) | |
| 694 | - (update-in % [channel :users] dissoc nick) | |
| 695 | - %)))) | |
| 663 | + (swap! channels members/remove-user channel nick)) | |
| 696 | 664 | |
| 697 | -(defn- remove-user-everywhere! | |
| 698 | - "A QUIT names no channel — the person left the server, so they left every | |
| 699 | - room this client is watching them in." | |
| 700 | - [nick] | |
| 701 | - (swap! channels | |
| 702 | - (fn [m] | |
| 703 | - (reduce-kv (fn [m k v] (assoc m k (update v :users dissoc nick))) | |
| 704 | - {} m)))) | |
| 705 | - | |
| 706 | -(defn- rename-user! | |
| 707 | - "A NICK, in every channel the old name was in. Their modes come with them: | |
| 708 | - renaming is not leaving." | |
| 709 | - [old new] | |
| 710 | - (swap! channels | |
| 711 | - (fn [m] | |
| 712 | - (reduce-kv (fn [m k v] | |
| 713 | - (assoc m k | |
| 714 | - (if-let [prefix (get (:users v) old)] | |
| 715 | - (update v :users #(-> % (dissoc old) (assoc new prefix))) | |
| 716 | - v))) | |
| 717 | - {} m)))) | |
| 718 | - | |
| 719 | -(defn- apply-mode! | |
| 720 | - "A channel MODE, for the letters that change how someone is listed. `params` | |
| 721 | - is the mode string and whoever it was applied to, in order; anything else in | |
| 722 | - it — a key, a limit, a ban — names no member and is skipped." | |
| 723 | - [channel modes args] | |
| 724 | - (let [letters {\q "~" \a "&" \o "@" \h "%" \v "+"}] | |
| 725 | - (loop [chars (seq modes) args args adding? true] | |
| 726 | - (when-let [c (first chars)] | |
| 727 | - (case c | |
| 728 | - \+ (recur (rest chars) args true) | |
| 729 | - \- (recur (rest chars) args false) | |
| 730 | - (if-let [prefix (letters c)] | |
| 731 | - (do (when-let [nick (first args)] | |
| 732 | - (swap! channels | |
| 733 | - (fn [m] | |
| 734 | - (if (get-in m [channel :users nick]) | |
| 735 | - (assoc-in m [channel :users nick] (if adding? prefix "")) | |
| 736 | - m)))) | |
| 737 | - (recur (rest chars) (rest args) adding?)) | |
| 738 | - ;; A mode that takes an argument without naming a member still eats | |
| 739 | - ;; one, and reading the next letter's nick out of the wrong place | |
| 740 | - ;; would put a mode on a stranger. Only the setting form takes one. | |
| 741 | - (recur (rest chars) (if adding? (rest args) args) adding?))))))) | |
| 742 | - | |
| 743 | -(def ^:private prefix-rank | |
| 744 | - (into {"" (count mode-prefixes)} | |
| 745 | - (map-indexed (fn [i c] [(str c) i]) mode-prefixes))) | |
| 746 | - | |
| 747 | -(defn member-list | |
| 748 | - "Who is in `channel`, as `{:nick :prefix}`, ops first and then alphabetically | |
| 749 | - — the order every other client lists them in, and the one a reader scanning | |
| 750 | - for a name expects." | |
| 751 | - [channel] | |
| 752 | - (->> (get-in @channels [channel :users]) | |
| 753 | - (map (fn [[nick prefix]] {:nick nick :prefix prefix})) | |
| 754 | - (sort-by (juxt #(prefix-rank (:prefix %) 99) #(str/lower-case (:nick %)))) | |
| 755 | - vec)) | |
| 665 | +(defn- remove-user-everywhere! [nick] | |
| 666 | + (swap! channels members/remove-everywhere nick)) | |
| 667 | + | |
| 668 | +(defn- rename-user! [old new] | |
| 669 | + (swap! channels members/rename-user old new)) | |
| 670 | + | |
| 671 | +(defn- apply-mode! [channel modes args] | |
| 672 | + (swap! channels members/with-mode channel modes args)) | |
| 673 | + | |
| 674 | +(defn member-list [channel] | |
| 675 | + (members/member-list @channels channel)) | |
| 756 | 676 | |
| 757 | 677 | (defn member-count [channel] |
| 758 | - (count (get-in @channels [channel :users]))) | |
| 678 | + (members/member-count @channels channel)) | |
| 759 | 679 | |
| 760 | 680 | (defn request-names! |
| 761 | 681 | "Ask who is in a channel we are already in. freeq re-joins an authenticated |
| @@ -6,6 +6,7 @@ | |||
| 6 | is the only place a wire message turns into UI state." | 6 | is the only place a wire message turns into UI state." |
| 7 | (:require [clojure.string :as str] | 7 | (:require [clojure.string :as str] |
| 8 | [frq.rooms :as rooms] | 8 | [frq.rooms :as rooms] |
| 9 | + [frq.members :as members] | ||
| 9 | [glimmer.ratom :as r :refer [atom]] | 10 | [glimmer.ratom :as r :refer [atom]] |
| 10 | [frq.actions :as actions] | 11 | [frq.actions :as actions] |
| 11 | [frq.cells :as cells] | 12 | [frq.cells :as cells] |
| @@ -642,120 +643,39 @@ | |||
| 642 | (or @found? :absent)))) | 643 | (or @found? :absent)))) |
| 643 | 644 | ||
| 644 | ;; --- who is in the room ------------------------------------------------------ | 645 | ;; --- who is in the room ------------------------------------------------------ |
| 645 | -;; A channel's `:users` is nick -> mode prefix ("@", "+", or ""). The list is | 646 | +;; All of it is `frq.members` now: a fold over the channels map, which is the |
| 646 | -;; the server's: NAMES on the way in, and every JOIN, PART, QUIT, KICK and NICK | 647 | +;; same fold under either compiler. What stays here is the atom it is folded |
| 647 | -;; after it. Nothing here asks who is there — being told is what membership is. | 648 | +;; into and `ensure-channel`, because a room means more to this half than to |
| 648 | - | 649 | +;; the phone — unread counts, read marks, a joining flag — and the shared |
| 649 | -(def ^:private mode-prefixes | 650 | +;; functions deliberately only ever touch `:users` and `:names-acc`. |
| 650 | - "The characters a server puts in front of a nick in NAMES, and in the same | 651 | + |
| 651 | - order the panel sorts them: owner, admin, op, half-op, voice." | 652 | +(defn- names-line [channel names] |
| 652 | - "~&@%+") | 653 | + (swap! channels #(members/with-names (ensure-channel % channel) channel names))) |
| 653 | - | 654 | + |
| 654 | -(defn- split-prefix | 655 | +(defn- names-end! [channel] |
| 655 | - "One NAMES entry into `[prefix nick]`. A nick never starts with one of these, | 656 | + (swap! channels members/names-done channel)) |
| 656 | - so what is in front of it is a mode and not part of the name." | ||
| 657 | - [entry] | ||
| 658 | - (if (and (seq entry) (str/index-of mode-prefixes (subs entry 0 1))) | ||
| 659 | - [(subs entry 0 1) (subs entry 1)] | ||
| 660 | - ["" entry])) | ||
| 661 | - | ||
| 662 | -(defn- names-line | ||
| 663 | - "Fold one 353 into the channel's pending list. Pending rather than live: the | ||
| 664 | - reply comes in as many lines as it takes and ends with 366, and replacing | ||
| 665 | - `:users` on each of them would empty the panel and refill it a name at a | ||
| 666 | - time." | ||
| 667 | - [channel names] | ||
| 668 | - (swap! channels | ||
| 669 | - (fn [m] | ||
| 670 | - (reduce (fn [m entry] | ||
| 671 | - (let [[prefix nick] (split-prefix entry)] | ||
| 672 | - (assoc-in m [channel :names-acc nick] prefix))) | ||
| 673 | - (ensure-channel m channel) | ||
| 674 | - (remove str/blank? (str/split (or names "") #" ")))))) | ||
| 675 | - | ||
| 676 | -(defn- names-end! | ||
| 677 | - "366: the pending list becomes the list." | ||
| 678 | - [channel] | ||
| 679 | - (swap! channels | ||
| 680 | - (fn [m] | ||
| 681 | - (if-let [acc (get-in m [channel :names-acc])] | ||
| 682 | - (-> m (assoc-in [channel :users] acc) | ||
| 683 | - (update channel dissoc :names-acc)) | ||
| 684 | - m)))) | ||
| 685 | 657 | ||
| 686 | (defn- add-user! [channel nick] | 658 | (defn- add-user! [channel nick] |
| 687 | (when (and channel nick) | 659 | (when (and channel nick) |
| 688 | - (swap! channels #(-> (ensure-channel % channel) | 660 | + (swap! channels #(members/add-user (ensure-channel % channel) channel nick)))) |
| 689 | - (update-in [channel :users] (fnil assoc {}) nick ""))))) | ||
| 690 | 661 | ||
| 691 | (defn- remove-user! [channel nick] | 662 | (defn- remove-user! [channel nick] |
| 692 | - (when (and channel nick) | 663 | + (swap! channels members/remove-user channel nick)) |
| 693 | - (swap! channels #(if (contains? % channel) | ||
| 694 | - (update-in % [channel :users] dissoc nick) | ||
| 695 | - %)))) | ||
| 696 | 664 | ||
| 697 | -(defn- remove-user-everywhere! | 665 | +(defn- remove-user-everywhere! [nick] |
| 698 | - "A QUIT names no channel — the person left the server, so they left every | 666 | + (swap! channels members/remove-everywhere nick)) |
| 699 | - room this client is watching them in." | 667 | + |
| 700 | - [nick] | 668 | +(defn- rename-user! [old new] |
| 701 | - (swap! channels | 669 | + (swap! channels members/rename-user old new)) |
| 702 | - (fn [m] | 670 | + |
| 703 | - (reduce-kv (fn [m k v] (assoc m k (update v :users dissoc nick))) | 671 | +(defn- apply-mode! [channel modes args] |
| 704 | - {} m)))) | 672 | + (swap! channels members/with-mode channel modes args)) |
| 705 | - | 673 | + |
| 706 | -(defn- rename-user! | 674 | +(defn member-list [channel] |
| 707 | - "A NICK, in every channel the old name was in. Their modes come with them: | 675 | + (members/member-list @channels channel)) |
| 708 | - renaming is not leaving." | ||
| 709 | - [old new] | ||
| 710 | - (swap! channels | ||
| 711 | - (fn [m] | ||
| 712 | - (reduce-kv (fn [m k v] | ||
| 713 | - (assoc m k | ||
| 714 | - (if-let [prefix (get (:users v) old)] | ||
| 715 | - (update v :users #(-> % (dissoc old) (assoc new prefix))) | ||
| 716 | - v))) | ||
| 717 | - {} m)))) | ||
| 718 | - | ||
| 719 | -(defn- apply-mode! | ||
| 720 | - "A channel MODE, for the letters that change how someone is listed. `params` | ||
| 721 | - is the mode string and whoever it was applied to, in order; anything else in | ||
| 722 | - it — a key, a limit, a ban — names no member and is skipped." | ||
| 723 | - [channel modes args] | ||
| 724 | - (let [letters {\q "~" \a "&" \o "@" \h "%" \v "+"}] | ||
| 725 | - (loop [chars (seq modes) args args adding? true] | ||
| 726 | - (when-let [c (first chars)] | ||
| 727 | - (case c | ||
| 728 | - \+ (recur (rest chars) args true) | ||
| 729 | - \- (recur (rest chars) args false) | ||
| 730 | - (if-let [prefix (letters c)] | ||
| 731 | - (do (when-let [nick (first args)] | ||
| 732 | - (swap! channels | ||
| 733 | - (fn [m] | ||
| 734 | - (if (get-in m [channel :users nick]) | ||
| 735 | - (assoc-in m [channel :users nick] (if adding? prefix "")) | ||
| 736 | - m)))) | ||
| 737 | - (recur (rest chars) (rest args) adding?)) | ||
| 738 | - ;; A mode that takes an argument without naming a member still eats | ||
| 739 | - ;; one, and reading the next letter's nick out of the wrong place | ||
| 740 | - ;; would put a mode on a stranger. Only the setting form takes one. | ||
| 741 | - (recur (rest chars) (if adding? (rest args) args) adding?))))))) | ||
| 742 | - | ||
| 743 | -(def ^:private prefix-rank | ||
| 744 | - (into {"" (count mode-prefixes)} | ||
| 745 | - (map-indexed (fn [i c] [(str c) i]) mode-prefixes))) | ||
| 746 | - | ||
| 747 | -(defn member-list | ||
| 748 | - "Who is in `channel`, as `{:nick :prefix}`, ops first and then alphabetically | ||
| 749 | - — the order every other client lists them in, and the one a reader scanning | ||
| 750 | - for a name expects." | ||
| 751 | - [channel] | ||
| 752 | - (->> (get-in @channels [channel :users]) | ||
| 753 | - (map (fn [[nick prefix]] {:nick nick :prefix prefix})) | ||
| 754 | - (sort-by (juxt #(prefix-rank (:prefix %) 99) #(str/lower-case (:nick %)))) | ||
| 755 | - vec)) | ||
| 756 | 676 | ||
| 757 | (defn member-count [channel] | 677 | (defn member-count [channel] |
| 758 | - (count (get-in @channels [channel :users]))) | 678 | + (members/member-count @channels channel)) |
| 759 | 679 | ||
| 760 | (defn request-names! | 680 | (defn request-names! |
| 761 | "Ask who is in a channel we are already in. freeq re-joins an authenticated | 681 | "Ask who is in a channel we are already in. freeq re-joins an authenticated |