Sign the reactions we send
freeq takes an unsigned reaction from a guest and refuses one from an account: `FAIL TAGMSG SIGNATURE_REQUIRED`. Nothing here read FAIL, so a pill appeared locally and reached nobody — the one client it looked right on was the one that sent it. So a signed-in connection now mints an Ed25519 key, registers it with MSGSIG at welcome, and signs each mutation over freeq's canonical description of it. The primitives are OpenSSL's, through the libcrypto jolt already loads for TLS; there is no other crypto to borrow and an Ed25519 written by hand is not a thing to put in a chat client. `echo-message` comes with it. Without it our own lines never came back and the local echo had no msgid, so a reaction on something we said had no message to name — the same silence, one step earlier. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
767b3bf parent: fd9ad7e modified
src/frq/irc.jolt +57 -15 | @@ -16,6 +16,7 @@ | ||
| 16 | 16 | `send-line!` and `close!` accept." |
| 17 | 17 | (:require [clojure.string :as str] |
| 18 | 18 | [frq.atproto :as atproto] |
| 19 | + [frq.msgsig :as msgsig] | |
| 19 | 20 | [jolt.ffi :as ffi] |
| 20 | 21 | [jolt.host :as host] |
| 21 | 22 | [jolt.mvn-http :as tls] |
| @@ -250,7 +251,7 @@ | ||
| 250 | 251 | ;; which is 30 seconds of nothing being sent. |
| 251 | 252 | (try (#'tls/set-timeouts! (:sock t) tls-poll-ms) (catch Exception _ nil)) |
| 252 | 253 | {:kind :tls :tls t :outbox (atom []) |
| 253 | - :lock (Object.) :nick nick})) | |
| 254 | + :lock (Object.) :nick nick :caps (atom #{})})) | |
| 254 | 255 | (let [ip (#'socket/ip->str (socket/resolve-host host)) |
| 255 | 256 | fd (socket/c-socket af-inet sock-stream 0)] |
| 256 | 257 | (when (neg? fd) (throw (ex-info "socket() failed" {:host host}))) |
| @@ -259,7 +260,7 @@ | ||
| 259 | 260 | (socket/c-close fd) |
| 260 | 261 | (throw (ex-info "connect() failed" {:host host :ip ip :port port})))) |
| 261 | 262 | {:kind :plain :fd fd :buf (ffi/alloc buffer-size) |
| 262 | - :lock (Object.) :nick nick}))) | |
| 263 | + :lock (Object.) :nick nick :caps (atom #{})}))) | |
| 263 | 264 | |
| 264 | 265 | (def ^:private sasl-chunk 400) |
| 265 | 266 | |
| @@ -284,8 +285,23 @@ | ||
| 284 | 285 | whatever someone chose today, and the hostmask carries eight characters of a |
| 285 | 286 | DID, too few to resolve. Both need `message-tags` beside them, since IRCv3 |
| 286 | 287 | sends tags only to clients that asked for tags at all; either one alone is |
| 287 | - ACKed and then nothing arrives." | |
| 288 | - ["message-tags" "server-time" "account-tag"]) | |
| 288 | + ACKed and then nothing arrives. | |
| 289 | + | |
| 290 | + `echo-message`: the server sends our own lines back to us, which is the only | |
| 291 | + way this client learns the msgid of something it said. Without it our own | |
| 292 | + messages sit in the buffer with no id, and a reaction or a reply aimed at one | |
| 293 | + has nothing to name — the pill appears here and nobody else ever sees it. | |
| 294 | + | |
| 295 | + `freeq.at/msgsig`: what lets a signed-in account react at all. freeq answers | |
| 296 | + an unsigned mutation from an account with | |
| 297 | + `FAIL TAGMSG SIGNATURE_REQUIRED`, and this cap is how a client says it can | |
| 298 | + register a key and sign one." | |
| 299 | + ["message-tags" "server-time" "account-tag" "echo-message" "freeq.at/msgsig"]) | |
| 300 | + | |
| 301 | +(defn cap-acked? | |
| 302 | + "Whether the server agreed to `cap` on this connection." | |
| 303 | + [conn cap] | |
| 304 | + (boolean (when-let [caps (:caps conn)] (contains? @caps cap)))) | |
| 289 | 305 | |
| 290 | 306 | (defn- cap-step! |
| 291 | 307 | "Drive capability negotiation, and the SASL exchange inside it when there is |
| @@ -304,9 +320,13 @@ | ||
| 304 | 320 | (send-line! conn "CAP END")) |
| 305 | 321 | ;; SASL, when acked, ends negotiation itself — CAP END waits |
| 306 | 322 | ;; for the exchange to finish either way. |
| 307 | - "ACK" (if (str/includes? (or caps "") "sasl") | |
| 308 | - (send-line! conn "AUTHENTICATE ATPROTO-CHALLENGE") | |
| 309 | - (send-line! conn "CAP END")) | |
| 323 | + "ACK" (do | |
| 324 | + (when-let [acked (:caps conn)] | |
| 325 | + (swap! acked into (remove str/blank? | |
| 326 | + (str/split (or caps "") #"\s+")))) | |
| 327 | + (if (str/includes? (or caps "") "sasl") | |
| 328 | + (send-line! conn "AUTHENTICATE ATPROTO-CHALLENGE") | |
| 329 | + (send-line! conn "CAP END"))) | |
| 310 | 330 | "NAK" (send-line! conn "CAP END") |
| 311 | 331 | nil)) |
| 312 | 332 | ;; The challenge arrives as base64url JSON; the nonce inside it is what |
| @@ -316,8 +336,18 @@ | ||
| 316 | 336 | (let [nonce (atproto/json-str |
| 317 | 337 | (atproto/b64-decode challenge) "nonce")] |
| 318 | 338 | (authenticate! conn (atproto/sasl-response session nonce))))) |
| 319 | - ;; 903 logged in, 904/905/906 did not. | |
| 320 | - ("903" "904" "905" "906") (send-line! conn "CAP END") | |
| 339 | + ;; 903 logged in, 904/905/906 did not. A login is also the moment this | |
| 340 | + ;; connection can have a signing key: the DID it signs as is only settled | |
| 341 | + ;; here. The key is registered at 001 rather than now — MSGSIG is a | |
| 342 | + ;; registered-client command, and negotiation has not ended yet. | |
| 343 | + "903" (do (when (and (cap-acked? conn "freeq.at/msgsig") (:did session)) | |
| 344 | + (msgsig/generate! (:did session))) | |
| 345 | + (send-line! conn "CAP END")) | |
| 346 | + ("904" "905" "906") (send-line! conn "CAP END") | |
| 347 | + ;; Welcomed. Hand the server the public half, and every reaction from | |
| 348 | + ;; here on carries a signature it will take. | |
| 349 | + "001" (when-let [pub (msgsig/public-key)] | |
| 350 | + (send-line! conn (str "MSGSIG " pub))) | |
| 321 | 351 | nil)) |
| 322 | 352 | msg) |
| 323 | 353 | |
| @@ -365,15 +395,27 @@ | ||
| 365 | 395 | (send-line! conn (str "@" (str/join ";" pairs) " TAGMSG " target)))) |
| 366 | 396 | |
| 367 | 397 | (defn react! |
| 368 | - "Put `emoji` on the message `msgid`, for everyone in `target` to see." | |
| 369 | - [conn target msgid emoji] | |
| 370 | - (tagmsg! conn target {"+react" emoji "+reply" msgid})) | |
| 398 | + "Put `emoji` on the message `msgid`, for everyone in `target` to see. | |
| 399 | + | |
| 400 | + Signed when this connection has a key. `peer-did` is who the DM is with, and | |
| 401 | + is what a DM signature names the conversation by; a channel does not need it." | |
| 402 | + ([conn target msgid emoji] (react! conn target msgid emoji nil)) | |
| 403 | + ([conn target msgid emoji peer-did] | |
| 404 | + (tagmsg! conn target (merge {"+react" emoji "+reply" msgid} | |
| 405 | + (msgsig/mutation-tags "react" target msgid | |
| 406 | + emoji peer-did))))) | |
| 371 | 407 | |
| 372 | 408 | (defn unreact! |
| 373 | 409 | "Take it off again. The server keys the removal by DID where there is one, so |
| 374 | - it survives a nick change and cannot be done on someone else's behalf." | |
| 375 | - [conn target msgid emoji] | |
| 376 | - (tagmsg! conn target {"+freeq.at/unreact" emoji "+reply" msgid})) | |
| 410 | + it survives a nick change and cannot be done on someone else's behalf. | |
| 411 | + | |
| 412 | + Signed like the reaction it undoes — taking a pill off is as much a change to | |
| 413 | + a message as putting one on, and the server asks for the same proof." | |
| 414 | + ([conn target msgid emoji] (unreact! conn target msgid emoji nil)) | |
| 415 | + ([conn target msgid emoji peer-did] | |
| 416 | + (tagmsg! conn target (merge {"+freeq.at/unreact" emoji "+reply" msgid} | |
| 417 | + (msgsig/mutation-tags "unreact" target msgid | |
| 418 | + emoji peer-did))))) | |
| 377 | 419 | |
| 378 | 420 | (defn close! [conn] |
| 379 | 421 | ;; Written straight out rather than queued: the reader may already be gone, |
| @@ -16,6 +16,7 @@ | |||
| 16 | `send-line!` and `close!` accept." | 16 | `send-line!` and `close!` accept." |
| 17 | (:require [clojure.string :as str] | 17 | (:require [clojure.string :as str] |
| 18 | [frq.atproto :as atproto] | 18 | [frq.atproto :as atproto] |
| 19 | + [frq.msgsig :as msgsig] | ||
| 19 | [jolt.ffi :as ffi] | 20 | [jolt.ffi :as ffi] |
| 20 | [jolt.host :as host] | 21 | [jolt.host :as host] |
| 21 | [jolt.mvn-http :as tls] | 22 | [jolt.mvn-http :as tls] |
| @@ -250,7 +251,7 @@ | |||
| 250 | ;; which is 30 seconds of nothing being sent. | 251 | ;; which is 30 seconds of nothing being sent. |
| 251 | (try (#'tls/set-timeouts! (:sock t) tls-poll-ms) (catch Exception _ nil)) | 252 | (try (#'tls/set-timeouts! (:sock t) tls-poll-ms) (catch Exception _ nil)) |
| 252 | {:kind :tls :tls t :outbox (atom []) | 253 | {:kind :tls :tls t :outbox (atom []) |
| 253 | - :lock (Object.) :nick nick})) | 254 | + :lock (Object.) :nick nick :caps (atom #{})})) |
| 254 | (let [ip (#'socket/ip->str (socket/resolve-host host)) | 255 | (let [ip (#'socket/ip->str (socket/resolve-host host)) |
| 255 | fd (socket/c-socket af-inet sock-stream 0)] | 256 | fd (socket/c-socket af-inet sock-stream 0)] |
| 256 | (when (neg? fd) (throw (ex-info "socket() failed" {:host host}))) | 257 | (when (neg? fd) (throw (ex-info "socket() failed" {:host host}))) |
| @@ -259,7 +260,7 @@ | |||
| 259 | (socket/c-close fd) | 260 | (socket/c-close fd) |
| 260 | (throw (ex-info "connect() failed" {:host host :ip ip :port port})))) | 261 | (throw (ex-info "connect() failed" {:host host :ip ip :port port})))) |
| 261 | {:kind :plain :fd fd :buf (ffi/alloc buffer-size) | 262 | {:kind :plain :fd fd :buf (ffi/alloc buffer-size) |
| 262 | - :lock (Object.) :nick nick}))) | 263 | + :lock (Object.) :nick nick :caps (atom #{})}))) |
| 263 | 264 | ||
| 264 | (def ^:private sasl-chunk 400) | 265 | (def ^:private sasl-chunk 400) |
| 265 | 266 | ||
| @@ -284,8 +285,23 @@ | |||
| 284 | whatever someone chose today, and the hostmask carries eight characters of a | 285 | whatever someone chose today, and the hostmask carries eight characters of a |
| 285 | DID, too few to resolve. Both need `message-tags` beside them, since IRCv3 | 286 | DID, too few to resolve. Both need `message-tags` beside them, since IRCv3 |
| 286 | sends tags only to clients that asked for tags at all; either one alone is | 287 | sends tags only to clients that asked for tags at all; either one alone is |
| 287 | - ACKed and then nothing arrives." | 288 | + ACKed and then nothing arrives. |
| 288 | - ["message-tags" "server-time" "account-tag"]) | 289 | + |
| 290 | + `echo-message`: the server sends our own lines back to us, which is the only | ||
| 291 | + way this client learns the msgid of something it said. Without it our own | ||
| 292 | + messages sit in the buffer with no id, and a reaction or a reply aimed at one | ||
| 293 | + has nothing to name — the pill appears here and nobody else ever sees it. | ||
| 294 | + | ||
| 295 | + `freeq.at/msgsig`: what lets a signed-in account react at all. freeq answers | ||
| 296 | + an unsigned mutation from an account with | ||
| 297 | + `FAIL TAGMSG SIGNATURE_REQUIRED`, and this cap is how a client says it can | ||
| 298 | + register a key and sign one." | ||
| 299 | + ["message-tags" "server-time" "account-tag" "echo-message" "freeq.at/msgsig"]) | ||
| 300 | + | ||
| 301 | +(defn cap-acked? | ||
| 302 | + "Whether the server agreed to `cap` on this connection." | ||
| 303 | + [conn cap] | ||
| 304 | + (boolean (when-let [caps (:caps conn)] (contains? @caps cap)))) | ||
| 289 | 305 | ||
| 290 | (defn- cap-step! | 306 | (defn- cap-step! |
| 291 | "Drive capability negotiation, and the SASL exchange inside it when there is | 307 | "Drive capability negotiation, and the SASL exchange inside it when there is |
| @@ -304,9 +320,13 @@ | |||
| 304 | (send-line! conn "CAP END")) | 320 | (send-line! conn "CAP END")) |
| 305 | ;; SASL, when acked, ends negotiation itself — CAP END waits | 321 | ;; SASL, when acked, ends negotiation itself — CAP END waits |
| 306 | ;; for the exchange to finish either way. | 322 | ;; for the exchange to finish either way. |
| 307 | - "ACK" (if (str/includes? (or caps "") "sasl") | 323 | + "ACK" (do |
| 308 | - (send-line! conn "AUTHENTICATE ATPROTO-CHALLENGE") | 324 | + (when-let [acked (:caps conn)] |
| 309 | - (send-line! conn "CAP END")) | 325 | + (swap! acked into (remove str/blank? |
| 326 | + (str/split (or caps "") #"\s+")))) | ||
| 327 | + (if (str/includes? (or caps "") "sasl") | ||
| 328 | + (send-line! conn "AUTHENTICATE ATPROTO-CHALLENGE") | ||
| 329 | + (send-line! conn "CAP END"))) | ||
| 310 | "NAK" (send-line! conn "CAP END") | 330 | "NAK" (send-line! conn "CAP END") |
| 311 | nil)) | 331 | nil)) |
| 312 | ;; The challenge arrives as base64url JSON; the nonce inside it is what | 332 | ;; The challenge arrives as base64url JSON; the nonce inside it is what |
| @@ -316,8 +336,18 @@ | |||
| 316 | (let [nonce (atproto/json-str | 336 | (let [nonce (atproto/json-str |
| 317 | (atproto/b64-decode challenge) "nonce")] | 337 | (atproto/b64-decode challenge) "nonce")] |
| 318 | (authenticate! conn (atproto/sasl-response session nonce))))) | 338 | (authenticate! conn (atproto/sasl-response session nonce))))) |
| 319 | - ;; 903 logged in, 904/905/906 did not. | 339 | + ;; 903 logged in, 904/905/906 did not. A login is also the moment this |
| 320 | - ("903" "904" "905" "906") (send-line! conn "CAP END") | 340 | + ;; connection can have a signing key: the DID it signs as is only settled |
| 341 | + ;; here. The key is registered at 001 rather than now — MSGSIG is a | ||
| 342 | + ;; registered-client command, and negotiation has not ended yet. | ||
| 343 | + "903" (do (when (and (cap-acked? conn "freeq.at/msgsig") (:did session)) | ||
| 344 | + (msgsig/generate! (:did session))) | ||
| 345 | + (send-line! conn "CAP END")) | ||
| 346 | + ("904" "905" "906") (send-line! conn "CAP END") | ||
| 347 | + ;; Welcomed. Hand the server the public half, and every reaction from | ||
| 348 | + ;; here on carries a signature it will take. | ||
| 349 | + "001" (when-let [pub (msgsig/public-key)] | ||
| 350 | + (send-line! conn (str "MSGSIG " pub))) | ||
| 321 | nil)) | 351 | nil)) |
| 322 | msg) | 352 | msg) |
| 323 | 353 | ||
| @@ -365,15 +395,27 @@ | |||
| 365 | (send-line! conn (str "@" (str/join ";" pairs) " TAGMSG " target)))) | 395 | (send-line! conn (str "@" (str/join ";" pairs) " TAGMSG " target)))) |
| 366 | 396 | ||
| 367 | (defn react! | 397 | (defn react! |
| 368 | - "Put `emoji` on the message `msgid`, for everyone in `target` to see." | 398 | + "Put `emoji` on the message `msgid`, for everyone in `target` to see. |
| 369 | - [conn target msgid emoji] | 399 | + |
| 370 | - (tagmsg! conn target {"+react" emoji "+reply" msgid})) | 400 | + Signed when this connection has a key. `peer-did` is who the DM is with, and |
| 401 | + is what a DM signature names the conversation by; a channel does not need it." | ||
| 402 | + ([conn target msgid emoji] (react! conn target msgid emoji nil)) | ||
| 403 | + ([conn target msgid emoji peer-did] | ||
| 404 | + (tagmsg! conn target (merge {"+react" emoji "+reply" msgid} | ||
| 405 | + (msgsig/mutation-tags "react" target msgid | ||
| 406 | + emoji peer-did))))) | ||
| 371 | 407 | ||
| 372 | (defn unreact! | 408 | (defn unreact! |
| 373 | "Take it off again. The server keys the removal by DID where there is one, so | 409 | "Take it off again. The server keys the removal by DID where there is one, so |
| 374 | - it survives a nick change and cannot be done on someone else's behalf." | 410 | + it survives a nick change and cannot be done on someone else's behalf. |
| 375 | - [conn target msgid emoji] | 411 | + |
| 376 | - (tagmsg! conn target {"+freeq.at/unreact" emoji "+reply" msgid})) | 412 | + Signed like the reaction it undoes — taking a pill off is as much a change to |
| 413 | + a message as putting one on, and the server asks for the same proof." | ||
| 414 | + ([conn target msgid emoji] (unreact! conn target msgid emoji nil)) | ||
| 415 | + ([conn target msgid emoji peer-did] | ||
| 416 | + (tagmsg! conn target (merge {"+freeq.at/unreact" emoji "+reply" msgid} | ||
| 417 | + (msgsig/mutation-tags "unreact" target msgid | ||
| 418 | + emoji peer-did))))) | ||
| 377 | 419 | ||
| 378 | (defn close! [conn] | 420 | (defn close! [conn] |
| 379 | ;; Written straight out rather than queued: the reader may already be gone, | 421 | ;; Written straight out rather than queued: the reader may already be gone, |
added
src/frq/msgsig.jolt +225 -0 | new file mode 100644 | ||
| @@ -0,0 +1,225 @@ | ||
| 1 | +(ns frq.msgsig | |
| 2 | + "Ed25519 signatures for the mutations freeq will not take on trust. | |
| 3 | + | |
| 4 | + A reaction is not a message: it changes something already said, and the | |
| 5 | + server refuses an unsigned one from an account — | |
| 6 | + `FAIL TAGMSG SIGNATURE_REQUIRED`. Guests are exempt, which is why a react | |
| 7 | + looks fine from a guest connection and vanishes from every other client the | |
| 8 | + moment you sign in. | |
| 9 | + | |
| 10 | + So a signed-in connection mints a throwaway Ed25519 key, registers the public | |
| 11 | + half with `MSGSIG` once it is welcomed, and signs each mutation over a | |
| 12 | + canonical description of what it does: who, what kind, which message, where, | |
| 13 | + and with which emoji. The key lives as long as the connection and is never | |
| 14 | + written down — it says only \"the account on this session did this\", which | |
| 15 | + is all the server is asking. | |
| 16 | + | |
| 17 | + The primitives are OpenSSL's, reached through the same libcrypto jolt already | |
| 18 | + loads for TLS. There is no other crypto here to borrow, and an Ed25519 | |
| 19 | + written by hand is not a thing to put in a chat client." | |
| 20 | + (:require [clojure.string :as str] | |
| 21 | + [jolt.ffi :as ffi] | |
| 22 | + [jolt.host :as host] | |
| 23 | + [jolt.mvn-http :as tls])) | |
| 24 | + | |
| 25 | +;; ---------------------------------------------------------------- libcrypto | |
| 26 | + | |
| 27 | +(ffi/defcfn c-rand-bytes "RAND_bytes" [:pointer :int] :int) | |
| 28 | +(ffi/defcfn c-new-raw-priv "EVP_PKEY_new_raw_private_key" | |
| 29 | + [:int :pointer :pointer :size_t] :pointer) | |
| 30 | +(ffi/defcfn c-get-raw-pub "EVP_PKEY_get_raw_public_key" | |
| 31 | + [:pointer :pointer :pointer] :int) | |
| 32 | +(ffi/defcfn c-pkey-free "EVP_PKEY_free" [:pointer] :void) | |
| 33 | +(ffi/defcfn c-md-ctx-new "EVP_MD_CTX_new" [] :pointer) | |
| 34 | +(ffi/defcfn c-md-ctx-free "EVP_MD_CTX_free" [:pointer] :void) | |
| 35 | +(ffi/defcfn c-sign-init "EVP_DigestSignInit" | |
| 36 | + [:pointer :pointer :pointer :pointer :pointer] :int) | |
| 37 | +(ffi/defcfn c-sign "EVP_DigestSign" [:pointer :pointer :pointer :pointer :size_t] :int) | |
| 38 | +(ffi/defcfn c-sha256 "SHA256" [:pointer :size_t :pointer] :pointer) | |
| 39 | + | |
| 40 | +;; EVP_PKEY_ED25519. The one NID this namespace needs, and the one number in | |
| 41 | +;; OpenSSL's table that would be a silent wrong key if it were wrong. | |
| 42 | +(def ^:private nid-ed25519 1087) | |
| 43 | + | |
| 44 | +;; ---------------------------------------------------------------- encoding | |
| 45 | + | |
| 46 | +(def ^:private b64url-alphabet | |
| 47 | + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_") | |
| 48 | + | |
| 49 | +(defn- b64url | |
| 50 | + "base64url of raw bytes, unpadded — how freeq writes a key and a signature. | |
| 51 | + | |
| 52 | + `frq.atproto/b64-encode` is the same encoding over a *string*, and a | |
| 53 | + signature is not one: run through a String it would come back re-encoded and | |
| 54 | + no longer verify." | |
| 55 | + [bs] | |
| 56 | + (let [bs (mapv #(bit-and (int %) 0xff) bs)] | |
| 57 | + (apply str | |
| 58 | + (for [group (partition-all 3 bs) | |
| 59 | + :let [[a b c] group | |
| 60 | + n (count group) | |
| 61 | + v (+ (bit-shift-left a 16) | |
| 62 | + (bit-shift-left (or b 0) 8) | |
| 63 | + (or c 0))] | |
| 64 | + i (range (inc n))] | |
| 65 | + (nth b64url-alphabet | |
| 66 | + (bit-and (bit-shift-right v (* 6 (- 3 i))) 0x3f)))))) | |
| 67 | + | |
| 68 | +(defn- random-bytes | |
| 69 | + "`n` bytes from OpenSSL's CSPRNG, or nil if it will not give them." | |
| 70 | + [n] | |
| 71 | + (let [buf (ffi/alloc n)] | |
| 72 | + (try (when (= 1 (c-rand-bytes buf n)) (ffi/read-array buf n)) | |
| 73 | + (finally (ffi/free buf))))) | |
| 74 | + | |
| 75 | +(defn- sha256 [bs] | |
| 76 | + (let [n (alength bs) | |
| 77 | + in (ffi/alloc (max 1 n)) | |
| 78 | + out (ffi/alloc 32)] | |
| 79 | + (try (ffi/write-array in bs) | |
| 80 | + (c-sha256 in n out) | |
| 81 | + (ffi/read-array out 32) | |
| 82 | + (finally (ffi/free in) (ffi/free out))))) | |
| 83 | + | |
| 84 | +;; ---------------------------------------------------------------- the key | |
| 85 | + | |
| 86 | +;; One key per connection: {:pkey <EVP_PKEY*> :public <b64url> :kid <b64url> | |
| 87 | +;; :did <did>}. Held here rather than on the connection because a signature is | |
| 88 | +;; not something the transport should be able to hand out. | |
| 89 | +(defonce ^:private signer (atom nil)) | |
| 90 | + | |
| 91 | +(defn forget! | |
| 92 | + "Drop the session key. Called when the connection goes, so a reconnect signs | |
| 93 | + with a key the server has actually been told about." | |
| 94 | + [] | |
| 95 | + (when-let [{:keys [pkey]} @signer] | |
| 96 | + (try (c-pkey-free pkey) (catch Exception _ nil))) | |
| 97 | + (reset! signer nil)) | |
| 98 | + | |
| 99 | +(defn public-key | |
| 100 | + "This connection's public key as base64url, or nil before there is one." | |
| 101 | + [] | |
| 102 | + (:public @signer)) | |
| 103 | + | |
| 104 | +(defn generate! | |
| 105 | + "Mint this connection's signing key for `did`, and return the public half as | |
| 106 | + base64url — the argument `MSGSIG` takes. nil if libcrypto will not play, and | |
| 107 | + then nothing is signed and reactions stay a thing only this client sees. | |
| 108 | + | |
| 109 | + The private key is a random 32-byte seed rather than a keygen context: for | |
| 110 | + Ed25519 the seed *is* the key, and `EVP_PKEY_new_raw_private_key` is the | |
| 111 | + whole of it." | |
| 112 | + [did] | |
| 113 | + (forget!) | |
| 114 | + (try | |
| 115 | + (tls/ensure-native!) | |
| 116 | + (when-let [seed (random-bytes 32)] | |
| 117 | + (let [buf (ffi/alloc 32)] | |
| 118 | + (try | |
| 119 | + (ffi/write-array buf seed) | |
| 120 | + (let [pkey (c-new-raw-priv nid-ed25519 ffi/null buf 32)] | |
| 121 | + (when-not (ffi/null? pkey) | |
| 122 | + (let [pub (ffi/alloc 32) | |
| 123 | + plen (ffi/alloc (ffi/sizeof :size_t))] | |
| 124 | + (try | |
| 125 | + (ffi/write plen :size_t 0 32) | |
| 126 | + (when (= 1 (c-get-raw-pub pkey pub plen)) | |
| 127 | + (let [raw (ffi/read-array pub 32)] | |
| 128 | + (reset! signer | |
| 129 | + {:pkey pkey | |
| 130 | + :did did | |
| 131 | + :public (b64url raw) | |
| 132 | + ;; The key id freeq names a signature by: the | |
| 133 | + ;; first half of the key's own SHA-256. | |
| 134 | + :kid (b64url (take 16 (sha256 raw)))}) | |
| 135 | + (:public @signer))) | |
| 136 | + (finally (ffi/free pub) (ffi/free plen)))))) | |
| 137 | + (finally (ffi/free buf))))) | |
| 138 | + (catch Exception _ nil))) | |
| 139 | + | |
| 140 | +(defn- sign-bytes | |
| 141 | + "An Ed25519 signature over `bs`, as `ed25519:<kid>:<b64url>` — the shape | |
| 142 | + freeq's `+freeq.at/sig` carries." | |
| 143 | + [bs] | |
| 144 | + (when-let [{:keys [pkey kid]} @signer] | |
| 145 | + (let [n (alength bs) | |
| 146 | + msg (ffi/alloc (max 1 n)) | |
| 147 | + sig (ffi/alloc 64) | |
| 148 | + slen (ffi/alloc (ffi/sizeof :size_t)) | |
| 149 | + ctx (c-md-ctx-new)] | |
| 150 | + (try | |
| 151 | + (ffi/write-array msg bs) | |
| 152 | + (ffi/write slen :size_t 0 64) | |
| 153 | + (when (and (= 1 (c-sign-init ctx ffi/null ffi/null ffi/null pkey)) | |
| 154 | + (= 1 (c-sign ctx sig slen msg n))) | |
| 155 | + (str "ed25519:" kid ":" (b64url (ffi/read-array sig (ffi/read slen :size_t))))) | |
| 156 | + (catch Exception _ nil) | |
| 157 | + (finally (ffi/free msg) (ffi/free sig) (ffi/free slen) (c-md-ctx-free ctx)))))) | |
| 158 | + | |
| 159 | +;; ---------------------------------------------------------------- canonical | |
| 160 | + | |
| 161 | +(defn- json-string [s] | |
| 162 | + (str "\"" (-> (or s "") | |
| 163 | + (str/replace "\\" "\\\\") | |
| 164 | + (str/replace "\"" "\\\"")) | |
| 165 | + "\"")) | |
| 166 | + | |
| 167 | +(defn- canonical | |
| 168 | + "The bytes that get signed: a JSON object with its keys in sorted order and | |
| 169 | + no space in it. Both ends build this string from the same fields and neither | |
| 170 | + sends it — a signature over anything else is a signature over nothing." | |
| 171 | + [m] | |
| 172 | + (.getBytes (str "{" | |
| 173 | + (str/join "," (for [[k v] (into (sorted-map) m)] | |
| 174 | + (str (json-string k) ":" (json-string v)))) | |
| 175 | + "}") | |
| 176 | + "UTF-8")) | |
| 177 | + | |
| 178 | +(def ^:private crockford "0123456789ABCDEFGHJKMNPQRSTVWXYZ") | |
| 179 | + | |
| 180 | +(defn- event-id | |
| 181 | + "A fresh id for this mutation: ten characters of the clock, then sixteen of | |
| 182 | + chance. Sortable like the msgids the server hands out, and unguessable | |
| 183 | + enough that two clients cannot mint the same one." | |
| 184 | + [] | |
| 185 | + (let [t (loop [t (quot (host/wall-nanos) 1000000) out ""] | |
| 186 | + (if (>= (count out) 10) | |
| 187 | + out | |
| 188 | + (recur (quot t 32) (str (nth crockford (mod t 32)) out))))] | |
| 189 | + (apply str t (for [b (or (random-bytes 16) (repeat 16 0))] | |
| 190 | + (nth crockford (mod (bit-and (int b) 0xff) 32)))))) | |
| 191 | + | |
| 192 | +(defn signing-target | |
| 193 | + "How freeq names the place a mutation happens: a channel by its lowercased | |
| 194 | + name, a DM by both DIDs in sorted order. nil when there is no way to say it | |
| 195 | + — a DM with someone whose DID we have not seen yet — and an unsigned | |
| 196 | + mutation is better than one signed over the wrong thing." | |
| 197 | + [target our-did peer-did] | |
| 198 | + (cond | |
| 199 | + (or (str/starts-with? (or target "") "#") | |
| 200 | + (str/starts-with? (or target "") "&")) (str/lower-case target) | |
| 201 | + (and (seq our-did) (seq peer-did)) (if (<= (compare our-did peer-did) 0) | |
| 202 | + (str "dm:" our-did "," peer-did) | |
| 203 | + (str "dm:" peer-did "," our-did)) | |
| 204 | + :else nil)) | |
| 205 | + | |
| 206 | +(defn mutation-tags | |
| 207 | + "The two tags that make a mutation acceptable: the event id and the signature | |
| 208 | + over it. Empty when this connection has no key — a guest signs nothing, and | |
| 209 | + the server asks nothing of one." | |
| 210 | + [kind target subject emoji peer-did] | |
| 211 | + (let [{:keys [did]} @signer] | |
| 212 | + (or (when did | |
| 213 | + (when-let [signed-target (signing-target target did peer-did)] | |
| 214 | + (let [id (event-id) | |
| 215 | + fields (cond-> {"from" did | |
| 216 | + "kind" kind | |
| 217 | + "msgid" id | |
| 218 | + "subject" subject | |
| 219 | + "target" signed-target} | |
| 220 | + (and (seq (or emoji "")) (not= "delete" kind)) | |
| 221 | + (assoc "emoji" emoji))] | |
| 222 | + (when-let [sig (sign-bytes (canonical fields))] | |
| 223 | + {"+freeq.at/eventid" id | |
| 224 | + "+freeq.at/sig" sig})))) | |
| 225 | + {}))) | |
| new file mode 100644 | |||
| @@ -0,0 +1,225 @@ | |||
| 1 | +(ns frq.msgsig | ||
| 2 | + "Ed25519 signatures for the mutations freeq will not take on trust. | ||
| 3 | + | ||
| 4 | + A reaction is not a message: it changes something already said, and the | ||
| 5 | + server refuses an unsigned one from an account — | ||
| 6 | + `FAIL TAGMSG SIGNATURE_REQUIRED`. Guests are exempt, which is why a react | ||
| 7 | + looks fine from a guest connection and vanishes from every other client the | ||
| 8 | + moment you sign in. | ||
| 9 | + | ||
| 10 | + So a signed-in connection mints a throwaway Ed25519 key, registers the public | ||
| 11 | + half with `MSGSIG` once it is welcomed, and signs each mutation over a | ||
| 12 | + canonical description of what it does: who, what kind, which message, where, | ||
| 13 | + and with which emoji. The key lives as long as the connection and is never | ||
| 14 | + written down — it says only \"the account on this session did this\", which | ||
| 15 | + is all the server is asking. | ||
| 16 | + | ||
| 17 | + The primitives are OpenSSL's, reached through the same libcrypto jolt already | ||
| 18 | + loads for TLS. There is no other crypto here to borrow, and an Ed25519 | ||
| 19 | + written by hand is not a thing to put in a chat client." | ||
| 20 | + (:require [clojure.string :as str] | ||
| 21 | + [jolt.ffi :as ffi] | ||
| 22 | + [jolt.host :as host] | ||
| 23 | + [jolt.mvn-http :as tls])) | ||
| 24 | + | ||
| 25 | +;; ---------------------------------------------------------------- libcrypto | ||
| 26 | + | ||
| 27 | +(ffi/defcfn c-rand-bytes "RAND_bytes" [:pointer :int] :int) | ||
| 28 | +(ffi/defcfn c-new-raw-priv "EVP_PKEY_new_raw_private_key" | ||
| 29 | + [:int :pointer :pointer :size_t] :pointer) | ||
| 30 | +(ffi/defcfn c-get-raw-pub "EVP_PKEY_get_raw_public_key" | ||
| 31 | + [:pointer :pointer :pointer] :int) | ||
| 32 | +(ffi/defcfn c-pkey-free "EVP_PKEY_free" [:pointer] :void) | ||
| 33 | +(ffi/defcfn c-md-ctx-new "EVP_MD_CTX_new" [] :pointer) | ||
| 34 | +(ffi/defcfn c-md-ctx-free "EVP_MD_CTX_free" [:pointer] :void) | ||
| 35 | +(ffi/defcfn c-sign-init "EVP_DigestSignInit" | ||
| 36 | + [:pointer :pointer :pointer :pointer :pointer] :int) | ||
| 37 | +(ffi/defcfn c-sign "EVP_DigestSign" [:pointer :pointer :pointer :pointer :size_t] :int) | ||
| 38 | +(ffi/defcfn c-sha256 "SHA256" [:pointer :size_t :pointer] :pointer) | ||
| 39 | + | ||
| 40 | +;; EVP_PKEY_ED25519. The one NID this namespace needs, and the one number in | ||
| 41 | +;; OpenSSL's table that would be a silent wrong key if it were wrong. | ||
| 42 | +(def ^:private nid-ed25519 1087) | ||
| 43 | + | ||
| 44 | +;; ---------------------------------------------------------------- encoding | ||
| 45 | + | ||
| 46 | +(def ^:private b64url-alphabet | ||
| 47 | + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_") | ||
| 48 | + | ||
| 49 | +(defn- b64url | ||
| 50 | + "base64url of raw bytes, unpadded — how freeq writes a key and a signature. | ||
| 51 | + | ||
| 52 | + `frq.atproto/b64-encode` is the same encoding over a *string*, and a | ||
| 53 | + signature is not one: run through a String it would come back re-encoded and | ||
| 54 | + no longer verify." | ||
| 55 | + [bs] | ||
| 56 | + (let [bs (mapv #(bit-and (int %) 0xff) bs)] | ||
| 57 | + (apply str | ||
| 58 | + (for [group (partition-all 3 bs) | ||
| 59 | + :let [[a b c] group | ||
| 60 | + n (count group) | ||
| 61 | + v (+ (bit-shift-left a 16) | ||
| 62 | + (bit-shift-left (or b 0) 8) | ||
| 63 | + (or c 0))] | ||
| 64 | + i (range (inc n))] | ||
| 65 | + (nth b64url-alphabet | ||
| 66 | + (bit-and (bit-shift-right v (* 6 (- 3 i))) 0x3f)))))) | ||
| 67 | + | ||
| 68 | +(defn- random-bytes | ||
| 69 | + "`n` bytes from OpenSSL's CSPRNG, or nil if it will not give them." | ||
| 70 | + [n] | ||
| 71 | + (let [buf (ffi/alloc n)] | ||
| 72 | + (try (when (= 1 (c-rand-bytes buf n)) (ffi/read-array buf n)) | ||
| 73 | + (finally (ffi/free buf))))) | ||
| 74 | + | ||
| 75 | +(defn- sha256 [bs] | ||
| 76 | + (let [n (alength bs) | ||
| 77 | + in (ffi/alloc (max 1 n)) | ||
| 78 | + out (ffi/alloc 32)] | ||
| 79 | + (try (ffi/write-array in bs) | ||
| 80 | + (c-sha256 in n out) | ||
| 81 | + (ffi/read-array out 32) | ||
| 82 | + (finally (ffi/free in) (ffi/free out))))) | ||
| 83 | + | ||
| 84 | +;; ---------------------------------------------------------------- the key | ||
| 85 | + | ||
| 86 | +;; One key per connection: {:pkey <EVP_PKEY*> :public <b64url> :kid <b64url> | ||
| 87 | +;; :did <did>}. Held here rather than on the connection because a signature is | ||
| 88 | +;; not something the transport should be able to hand out. | ||
| 89 | +(defonce ^:private signer (atom nil)) | ||
| 90 | + | ||
| 91 | +(defn forget! | ||
| 92 | + "Drop the session key. Called when the connection goes, so a reconnect signs | ||
| 93 | + with a key the server has actually been told about." | ||
| 94 | + [] | ||
| 95 | + (when-let [{:keys [pkey]} @signer] | ||
| 96 | + (try (c-pkey-free pkey) (catch Exception _ nil))) | ||
| 97 | + (reset! signer nil)) | ||
| 98 | + | ||
| 99 | +(defn public-key | ||
| 100 | + "This connection's public key as base64url, or nil before there is one." | ||
| 101 | + [] | ||
| 102 | + (:public @signer)) | ||
| 103 | + | ||
| 104 | +(defn generate! | ||
| 105 | + "Mint this connection's signing key for `did`, and return the public half as | ||
| 106 | + base64url — the argument `MSGSIG` takes. nil if libcrypto will not play, and | ||
| 107 | + then nothing is signed and reactions stay a thing only this client sees. | ||
| 108 | + | ||
| 109 | + The private key is a random 32-byte seed rather than a keygen context: for | ||
| 110 | + Ed25519 the seed *is* the key, and `EVP_PKEY_new_raw_private_key` is the | ||
| 111 | + whole of it." | ||
| 112 | + [did] | ||
| 113 | + (forget!) | ||
| 114 | + (try | ||
| 115 | + (tls/ensure-native!) | ||
| 116 | + (when-let [seed (random-bytes 32)] | ||
| 117 | + (let [buf (ffi/alloc 32)] | ||
| 118 | + (try | ||
| 119 | + (ffi/write-array buf seed) | ||
| 120 | + (let [pkey (c-new-raw-priv nid-ed25519 ffi/null buf 32)] | ||
| 121 | + (when-not (ffi/null? pkey) | ||
| 122 | + (let [pub (ffi/alloc 32) | ||
| 123 | + plen (ffi/alloc (ffi/sizeof :size_t))] | ||
| 124 | + (try | ||
| 125 | + (ffi/write plen :size_t 0 32) | ||
| 126 | + (when (= 1 (c-get-raw-pub pkey pub plen)) | ||
| 127 | + (let [raw (ffi/read-array pub 32)] | ||
| 128 | + (reset! signer | ||
| 129 | + {:pkey pkey | ||
| 130 | + :did did | ||
| 131 | + :public (b64url raw) | ||
| 132 | + ;; The key id freeq names a signature by: the | ||
| 133 | + ;; first half of the key's own SHA-256. | ||
| 134 | + :kid (b64url (take 16 (sha256 raw)))}) | ||
| 135 | + (:public @signer))) | ||
| 136 | + (finally (ffi/free pub) (ffi/free plen)))))) | ||
| 137 | + (finally (ffi/free buf))))) | ||
| 138 | + (catch Exception _ nil))) | ||
| 139 | + | ||
| 140 | +(defn- sign-bytes | ||
| 141 | + "An Ed25519 signature over `bs`, as `ed25519:<kid>:<b64url>` — the shape | ||
| 142 | + freeq's `+freeq.at/sig` carries." | ||
| 143 | + [bs] | ||
| 144 | + (when-let [{:keys [pkey kid]} @signer] | ||
| 145 | + (let [n (alength bs) | ||
| 146 | + msg (ffi/alloc (max 1 n)) | ||
| 147 | + sig (ffi/alloc 64) | ||
| 148 | + slen (ffi/alloc (ffi/sizeof :size_t)) | ||
| 149 | + ctx (c-md-ctx-new)] | ||
| 150 | + (try | ||
| 151 | + (ffi/write-array msg bs) | ||
| 152 | + (ffi/write slen :size_t 0 64) | ||
| 153 | + (when (and (= 1 (c-sign-init ctx ffi/null ffi/null ffi/null pkey)) | ||
| 154 | + (= 1 (c-sign ctx sig slen msg n))) | ||
| 155 | + (str "ed25519:" kid ":" (b64url (ffi/read-array sig (ffi/read slen :size_t))))) | ||
| 156 | + (catch Exception _ nil) | ||
| 157 | + (finally (ffi/free msg) (ffi/free sig) (ffi/free slen) (c-md-ctx-free ctx)))))) | ||
| 158 | + | ||
| 159 | +;; ---------------------------------------------------------------- canonical | ||
| 160 | + | ||
| 161 | +(defn- json-string [s] | ||
| 162 | + (str "\"" (-> (or s "") | ||
| 163 | + (str/replace "\\" "\\\\") | ||
| 164 | + (str/replace "\"" "\\\"")) | ||
| 165 | + "\"")) | ||
| 166 | + | ||
| 167 | +(defn- canonical | ||
| 168 | + "The bytes that get signed: a JSON object with its keys in sorted order and | ||
| 169 | + no space in it. Both ends build this string from the same fields and neither | ||
| 170 | + sends it — a signature over anything else is a signature over nothing." | ||
| 171 | + [m] | ||
| 172 | + (.getBytes (str "{" | ||
| 173 | + (str/join "," (for [[k v] (into (sorted-map) m)] | ||
| 174 | + (str (json-string k) ":" (json-string v)))) | ||
| 175 | + "}") | ||
| 176 | + "UTF-8")) | ||
| 177 | + | ||
| 178 | +(def ^:private crockford "0123456789ABCDEFGHJKMNPQRSTVWXYZ") | ||
| 179 | + | ||
| 180 | +(defn- event-id | ||
| 181 | + "A fresh id for this mutation: ten characters of the clock, then sixteen of | ||
| 182 | + chance. Sortable like the msgids the server hands out, and unguessable | ||
| 183 | + enough that two clients cannot mint the same one." | ||
| 184 | + [] | ||
| 185 | + (let [t (loop [t (quot (host/wall-nanos) 1000000) out ""] | ||
| 186 | + (if (>= (count out) 10) | ||
| 187 | + out | ||
| 188 | + (recur (quot t 32) (str (nth crockford (mod t 32)) out))))] | ||
| 189 | + (apply str t (for [b (or (random-bytes 16) (repeat 16 0))] | ||
| 190 | + (nth crockford (mod (bit-and (int b) 0xff) 32)))))) | ||
| 191 | + | ||
| 192 | +(defn signing-target | ||
| 193 | + "How freeq names the place a mutation happens: a channel by its lowercased | ||
| 194 | + name, a DM by both DIDs in sorted order. nil when there is no way to say it | ||
| 195 | + — a DM with someone whose DID we have not seen yet — and an unsigned | ||
| 196 | + mutation is better than one signed over the wrong thing." | ||
| 197 | + [target our-did peer-did] | ||
| 198 | + (cond | ||
| 199 | + (or (str/starts-with? (or target "") "#") | ||
| 200 | + (str/starts-with? (or target "") "&")) (str/lower-case target) | ||
| 201 | + (and (seq our-did) (seq peer-did)) (if (<= (compare our-did peer-did) 0) | ||
| 202 | + (str "dm:" our-did "," peer-did) | ||
| 203 | + (str "dm:" peer-did "," our-did)) | ||
| 204 | + :else nil)) | ||
| 205 | + | ||
| 206 | +(defn mutation-tags | ||
| 207 | + "The two tags that make a mutation acceptable: the event id and the signature | ||
| 208 | + over it. Empty when this connection has no key — a guest signs nothing, and | ||
| 209 | + the server asks nothing of one." | ||
| 210 | + [kind target subject emoji peer-did] | ||
| 211 | + (let [{:keys [did]} @signer] | ||
| 212 | + (or (when did | ||
| 213 | + (when-let [signed-target (signing-target target did peer-did)] | ||
| 214 | + (let [id (event-id) | ||
| 215 | + fields (cond-> {"from" did | ||
| 216 | + "kind" kind | ||
| 217 | + "msgid" id | ||
| 218 | + "subject" subject | ||
| 219 | + "target" signed-target} | ||
| 220 | + (and (seq (or emoji "")) (not= "delete" kind)) | ||
| 221 | + (assoc "emoji" emoji))] | ||
| 222 | + (when-let [sig (sign-bytes (canonical fields))] | ||
| 223 | + {"+freeq.at/eventid" id | ||
| 224 | + "+freeq.at/sig" sig})))) | ||
| 225 | + {}))) | ||
modified
src/frq/state.jolt +37 -9 | @@ -12,6 +12,7 @@ | ||
| 12 | 12 | [frq.clock :as clock] |
| 13 | 13 | [frq.emoji :as emoji] |
| 14 | 14 | [frq.irc :as irc] |
| 15 | + [frq.msgsig :as msgsig] | |
| 15 | 16 | [frq.avatars :as avatars] |
| 16 | 17 | [frq.media :as media] |
| 17 | 18 | [frq.oauth :as oauth] |
| @@ -340,8 +341,13 @@ | ||
| 340 | 341 | at (or (clock/parse-time-tag (:tags msg)) (clock/now-ms)) |
| 341 | 342 | tags (:tags msg) |
| 342 | 343 | ;; a DM addressed to us belongs in a buffer named for the |
| 343 | - ;; sender, not for our own nick | |
| 344 | - buffer (if (str/starts-with? (or target "") "#") target from)] | |
| 344 | + ;; sender, not for our own nick — except when the sender | |
| 345 | + ;; is us: `echo-message` sends our own DM back, and the | |
| 346 | + ;; buffer it belongs to is the one we sent it to. | |
| 347 | + buffer (cond | |
| 348 | + (str/starts-with? (or target "") "#") target | |
| 349 | + (= from @form-nick) target | |
| 350 | + :else from)] | |
| 345 | 351 | (push-message! buffer from text |
| 346 | 352 | {:at at |
| 347 | 353 | :did (:account msg) |
| @@ -435,7 +441,11 @@ | ||
| 435 | 441 | (store/clear-session!) |
| 436 | 442 | (reset! error (str "Bluesky sign-in refused: " |
| 437 | 443 | (or (last params) "no reason given")))) |
| 438 | - "*DISCONNECTED*" (do (reset! conn nil) | |
| 444 | + ;; The signing key belonged to that connection: the server forgets it | |
| 445 | + ;; when the session ends, and signing with it afterwards would be | |
| 446 | + ;; signing with a key nobody can check. | |
| 447 | + "*DISCONNECTED*" (do (msgsig/forget!) | |
| 448 | + (reset! conn nil) | |
| 439 | 449 | (reset! connecting? false) |
| 440 | 450 | (swap! channels |
| 441 | 451 | #(reduce-kv (fn [m k v] |
| @@ -878,9 +888,11 @@ | ||
| 878 | 888 | ;; Saying something is a way of asking to see it. |
| 879 | 889 | (jump-to-present!) |
| 880 | 890 | (when-let [c @conn] (irc/privmsg! c target line (:id reply-to))) |
| 881 | - ;; The local echo carries the same link, so the chip is there before | |
| 882 | - ;; the server's copy of the line comes back — if it ever does. | |
| 883 | - (push-message! target @form-nick line {:reply-to (:id reply-to)}) | |
| 891 | + ;; Only when the server will not send the line back itself. Its copy | |
| 892 | + ;; carries the msgid, and a message with no id is one nobody can react | |
| 893 | + ;; or reply to; echoing locally as well would put the line up twice. | |
| 894 | + (when-not (some-> @conn (irc/cap-acked? "echo-message")) | |
| 895 | + (push-message! target @form-nick line {:reply-to (:id reply-to)})) | |
| 884 | 896 | (reset! replying-to nil) |
| 885 | 897 | (reset! draft "") |
| 886 | 898 | (when att |
| @@ -930,6 +942,17 @@ | ||
| 930 | 942 | group (vec (filter (fn [[_ _ g]] (= g group)) emoji/catalog)) |
| 931 | 943 | :else (mapv (fn [glyph] [glyph glyph nil]) emoji/popular)))) |
| 932 | 944 | |
| 945 | +(defn- dm-peer-did | |
| 946 | + "The DID of whoever this DM buffer is with, from the last thing they said. | |
| 947 | + nil for a channel, and for a conversation where nobody with a DID has spoken | |
| 948 | + — a signature over a DM needs both sides named, and there is nothing to name." | |
| 949 | + [channel] | |
| 950 | + (when-not (str/starts-with? (or channel "") "#") | |
| 951 | + (->> (get-in @channels [channel :messages]) | |
| 952 | + (remove #(= @form-nick (:from %))) | |
| 953 | + (keep :did) | |
| 954 | + last))) | |
| 955 | + | |
| 933 | 956 | (defn my-reaction? |
| 934 | 957 | "Whether this nick is already on that emoji — which is what makes a second |
| 935 | 958 | click take it off rather than send the same reaction twice." |
| @@ -944,11 +967,16 @@ | ||
| 944 | 967 | appear once someone else reacted too." |
| 945 | 968 | [channel m emoji] |
| 946 | 969 | (when-let [msgid (:id m)] |
| 947 | - (let [on? (not (my-reaction? m emoji))] | |
| 970 | + (let [on? (not (my-reaction? m emoji)) | |
| 971 | + ;; Who the DM is with, for the signature: freeq names a DM by both | |
| 972 | + ;; DIDs rather than by a nick, and nothing else in a buffer says | |
| 973 | + ;; which account the other side is. nil in a channel, which is named | |
| 974 | + ;; by itself. | |
| 975 | + peer (dm-peer-did channel)] | |
| 948 | 976 | (when-let [c @conn] |
| 949 | 977 | (if on? |
| 950 | - (irc/react! c channel msgid emoji) | |
| 951 | - (irc/unreact! c channel msgid emoji))) | |
| 978 | + (irc/react! c channel msgid emoji peer) | |
| 979 | + (irc/unreact! c channel msgid emoji peer))) | |
| 952 | 980 | (update-reaction! channel msgid emoji @form-nick on?)))) |
| 953 | 981 | |
| 954 | 982 | (defn start-call! |
| @@ -12,6 +12,7 @@ | |||
| 12 | [frq.clock :as clock] | 12 | [frq.clock :as clock] |
| 13 | [frq.emoji :as emoji] | 13 | [frq.emoji :as emoji] |
| 14 | [frq.irc :as irc] | 14 | [frq.irc :as irc] |
| 15 | + [frq.msgsig :as msgsig] | ||
| 15 | [frq.avatars :as avatars] | 16 | [frq.avatars :as avatars] |
| 16 | [frq.media :as media] | 17 | [frq.media :as media] |
| 17 | [frq.oauth :as oauth] | 18 | [frq.oauth :as oauth] |
| @@ -340,8 +341,13 @@ | |||
| 340 | at (or (clock/parse-time-tag (:tags msg)) (clock/now-ms)) | 341 | at (or (clock/parse-time-tag (:tags msg)) (clock/now-ms)) |
| 341 | tags (:tags msg) | 342 | tags (:tags msg) |
| 342 | ;; a DM addressed to us belongs in a buffer named for the | 343 | ;; a DM addressed to us belongs in a buffer named for the |
| 343 | - ;; sender, not for our own nick | 344 | + ;; sender, not for our own nick — except when the sender |
| 344 | - buffer (if (str/starts-with? (or target "") "#") target from)] | 345 | + ;; is us: `echo-message` sends our own DM back, and the |
| 346 | + ;; buffer it belongs to is the one we sent it to. | ||
| 347 | + buffer (cond | ||
| 348 | + (str/starts-with? (or target "") "#") target | ||
| 349 | + (= from @form-nick) target | ||
| 350 | + :else from)] | ||
| 345 | (push-message! buffer from text | 351 | (push-message! buffer from text |
| 346 | {:at at | 352 | {:at at |
| 347 | :did (:account msg) | 353 | :did (:account msg) |
| @@ -435,7 +441,11 @@ | |||
| 435 | (store/clear-session!) | 441 | (store/clear-session!) |
| 436 | (reset! error (str "Bluesky sign-in refused: " | 442 | (reset! error (str "Bluesky sign-in refused: " |
| 437 | (or (last params) "no reason given")))) | 443 | (or (last params) "no reason given")))) |
| 438 | - "*DISCONNECTED*" (do (reset! conn nil) | 444 | + ;; The signing key belonged to that connection: the server forgets it |
| 445 | + ;; when the session ends, and signing with it afterwards would be | ||
| 446 | + ;; signing with a key nobody can check. | ||
| 447 | + "*DISCONNECTED*" (do (msgsig/forget!) | ||
| 448 | + (reset! conn nil) | ||
| 439 | (reset! connecting? false) | 449 | (reset! connecting? false) |
| 440 | (swap! channels | 450 | (swap! channels |
| 441 | #(reduce-kv (fn [m k v] | 451 | #(reduce-kv (fn [m k v] |
| @@ -878,9 +888,11 @@ | |||
| 878 | ;; Saying something is a way of asking to see it. | 888 | ;; Saying something is a way of asking to see it. |
| 879 | (jump-to-present!) | 889 | (jump-to-present!) |
| 880 | (when-let [c @conn] (irc/privmsg! c target line (:id reply-to))) | 890 | (when-let [c @conn] (irc/privmsg! c target line (:id reply-to))) |
| 881 | - ;; The local echo carries the same link, so the chip is there before | 891 | + ;; Only when the server will not send the line back itself. Its copy |
| 882 | - ;; the server's copy of the line comes back — if it ever does. | 892 | + ;; carries the msgid, and a message with no id is one nobody can react |
| 883 | - (push-message! target @form-nick line {:reply-to (:id reply-to)}) | 893 | + ;; or reply to; echoing locally as well would put the line up twice. |
| 894 | + (when-not (some-> @conn (irc/cap-acked? "echo-message")) | ||
| 895 | + (push-message! target @form-nick line {:reply-to (:id reply-to)})) | ||
| 884 | (reset! replying-to nil) | 896 | (reset! replying-to nil) |
| 885 | (reset! draft "") | 897 | (reset! draft "") |
| 886 | (when att | 898 | (when att |
| @@ -930,6 +942,17 @@ | |||
| 930 | group (vec (filter (fn [[_ _ g]] (= g group)) emoji/catalog)) | 942 | group (vec (filter (fn [[_ _ g]] (= g group)) emoji/catalog)) |
| 931 | :else (mapv (fn [glyph] [glyph glyph nil]) emoji/popular)))) | 943 | :else (mapv (fn [glyph] [glyph glyph nil]) emoji/popular)))) |
| 932 | 944 | ||
| 945 | +(defn- dm-peer-did | ||
| 946 | + "The DID of whoever this DM buffer is with, from the last thing they said. | ||
| 947 | + nil for a channel, and for a conversation where nobody with a DID has spoken | ||
| 948 | + — a signature over a DM needs both sides named, and there is nothing to name." | ||
| 949 | + [channel] | ||
| 950 | + (when-not (str/starts-with? (or channel "") "#") | ||
| 951 | + (->> (get-in @channels [channel :messages]) | ||
| 952 | + (remove #(= @form-nick (:from %))) | ||
| 953 | + (keep :did) | ||
| 954 | + last))) | ||
| 955 | + | ||
| 933 | (defn my-reaction? | 956 | (defn my-reaction? |
| 934 | "Whether this nick is already on that emoji — which is what makes a second | 957 | "Whether this nick is already on that emoji — which is what makes a second |
| 935 | click take it off rather than send the same reaction twice." | 958 | click take it off rather than send the same reaction twice." |
| @@ -944,11 +967,16 @@ | |||
| 944 | appear once someone else reacted too." | 967 | appear once someone else reacted too." |
| 945 | [channel m emoji] | 968 | [channel m emoji] |
| 946 | (when-let [msgid (:id m)] | 969 | (when-let [msgid (:id m)] |
| 947 | - (let [on? (not (my-reaction? m emoji))] | 970 | + (let [on? (not (my-reaction? m emoji)) |
| 971 | + ;; Who the DM is with, for the signature: freeq names a DM by both | ||
| 972 | + ;; DIDs rather than by a nick, and nothing else in a buffer says | ||
| 973 | + ;; which account the other side is. nil in a channel, which is named | ||
| 974 | + ;; by itself. | ||
| 975 | + peer (dm-peer-did channel)] | ||
| 948 | (when-let [c @conn] | 976 | (when-let [c @conn] |
| 949 | (if on? | 977 | (if on? |
| 950 | - (irc/react! c channel msgid emoji) | 978 | + (irc/react! c channel msgid emoji peer) |
| 951 | - (irc/unreact! c channel msgid emoji))) | 979 | + (irc/unreact! c channel msgid emoji peer))) |
| 952 | (update-reaction! channel msgid emoji @form-nick on?)))) | 980 | (update-reaction! channel msgid emoji @form-nick on?)))) |
| 953 | 981 | ||
| 954 | (defn start-call! | 982 | (defn start-call! |