nandi/frqpublic Fork 0
618f3f9
Commits
Clone
git clone https://git.rickub.com/nandi/frq.git
git clone ssh://git@rickub.com/nandi/frq.git

Host key fingerprint (ed25519): SHA256:iycHnxEyq0Q7uyVpB7JlznP0G7JrTPXLYRcAU5CSLhc — verify it before your first connect.

Let the reader answer the policy a room asks them to accept

A channel that refuses a JOIN with "use POLICY <channel> ACCEPT" was a wall:
the instruction was in the buffer and there was no way to follow it. Now a
line typed with a leading slash goes to the server as it stands, and the
refusal itself puts the room's policy and one Accept button above the
backlog. The rules arrive as bare NOTICEs naming no channel, so the question
is remembered and its answer filed under the room that asked.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
nandi committed 2026-09-07T00:08:54-07:00 Browse files
618f3f9 parent: aaa97c3
modified src/frq/app.jolt +19 -0
@@ -1276,6 +1276,22 @@
12761276 (str "chat-messages-" @s/jump-tick)
12771277 "chat-messages"))
12781278
1279+(defn- policy-note
1280+ "What this channel wants agreed to, and the one button that agrees to it.
1281+
1282+ Above the backlog rather than in it: the refusal is already a line in the
1283+ buffer, and a button scrolled away with last week's messages is a button
1284+ nobody finds. The rules come from the server; when it has none to give, its
1285+ own words about that are what shows."
1286+ [name buffer]
1287+ (when (:policy-required? buffer)
1288+ [:vbox {:spacing 4}
1289+ [:dim-label {:label (str name " asks you to accept its policy before joining.")}]
1290+ (for [[i line] (map-indexed vector (:policy-text buffer))]
1291+ ^{:key (str "policy-" i)} [:dim-label {:label line}])
1292+ [:button {:label "Accept policy" :kind :primary
1293+ :on-click #(s/accept-policy! name)}]]))
1294+
12791295 (defn chat-screen []
12801296 (let [name @s/current
12811297 buffer (get @s/channels name)
@@ -1321,6 +1337,9 @@
13211337 :kind (when @s/show-users? :primary)
13221338 :on-click s/toggle-users!}])]]
13231339 [error-note]
1340+ ;; In a wrapper of its own, for the reconciler's sake: it comes and goes.
1341+ [:vbox {:key :policy}
1342+ (policy-note name buffer)]
13241343 [call-bar name]
13251344 ;; :reserve leaves room for everything below: the jump button's row, the
13261345 ;; separator and the compose bar. It does not vary with whether the button
@@ -1276,6 +1276,22 @@
1276 (str "chat-messages-" @s/jump-tick)1276 (str "chat-messages-" @s/jump-tick)
1277 "chat-messages"))1277 "chat-messages"))
1278 1278
1279+(defn- policy-note
1280+ "What this channel wants agreed to, and the one button that agrees to it.
1281+
1282+ Above the backlog rather than in it: the refusal is already a line in the
1283+ buffer, and a button scrolled away with last week's messages is a button
1284+ nobody finds. The rules come from the server; when it has none to give, its
1285+ own words about that are what shows."
1286+ [name buffer]
1287+ (when (:policy-required? buffer)
1288+ [:vbox {:spacing 4}
1289+ [:dim-label {:label (str name " asks you to accept its policy before joining.")}]
1290+ (for [[i line] (map-indexed vector (:policy-text buffer))]
1291+ ^{:key (str "policy-" i)} [:dim-label {:label line}])
1292+ [:button {:label "Accept policy" :kind :primary
1293+ :on-click #(s/accept-policy! name)}]]))
1294+
1279 (defn chat-screen []1295 (defn chat-screen []
1280 (let [name @s/current1296 (let [name @s/current
1281 buffer (get @s/channels name)1297 buffer (get @s/channels name)
@@ -1321,6 +1337,9 @@
1321 :kind (when @s/show-users? :primary)1337 :kind (when @s/show-users? :primary)
1322 :on-click s/toggle-users!}])]]1338 :on-click s/toggle-users!}])]]
1323 [error-note]1339 [error-note]
1340+ ;; In a wrapper of its own, for the reconciler's sake: it comes and goes.
1341+ [:vbox {:key :policy}
1342+ (policy-note name buffer)]
1324 [call-bar name]1343 [call-bar name]
1325 ;; :reserve leaves room for everything below: the jump button's row, the1344 ;; :reserve leaves room for everything below: the jump button's row, the
1326 ;; separator and the compose bar. It does not vary with whether the button1345 ;; separator and the compose bar. It does not vary with whether the button
modified src/frq/state.jolt +71 -4
@@ -798,11 +798,49 @@
798798 (= session-id (:session-id lc))))
799799 (av/stop-media!))))))
800800
801+;; Which channel's POLICY reply is outstanding, or nil. The server answers
802+;; POLICY with a run of NOTICEs addressed to our nick and naming no channel;
803+;; without this they land in the status banner one at a time, and the rules
804+;; the reader is being asked to accept are never readable.
805+;;
806+;; ponytail: the run ends at the first line that is not a NOTICE, so a PING
807+;; landing mid-answer truncates the rules. A reply-tag or a POLICY numeric
808+;; from the server would end it properly.
809+(defonce ^:private policy-asking (atom nil))
810+
811+(defn ask-policy!
812+ "Ask the server what this channel's policy says, so the reader can read what
813+ they are being asked to accept.
814+
815+ The answer comes back as plain NOTICEs to our nick, naming no channel so
816+ the question is remembered here, and the lines that follow it are filed
817+ under the channel that asked."
818+ [ch]
819+ (swap! channels #(assoc-in (ensure-channel % ch) [ch :policy-text] []))
820+ (reset! policy-asking ch)
821+ (when-let [c @conn]
822+ (irc/send-line! c (str "POLICY " ch " RULES"))
823+ (irc/send-line! c (str "POLICY " ch " INFO"))))
824+
825+(defn accept-policy!
826+ "Accept the channel's policy and go back in. The JOIN follows immediately:
827+ accepting is only ever done in order to be in the room, and the server takes
828+ the two in the order they are sent."
829+ [ch]
830+ (when-let [c @conn]
831+ (irc/send-line! c (str "POLICY " ch " ACCEPT"))
832+ (swap! channels #(-> (ensure-channel % ch)
833+ (assoc-in [ch :policy-required?] false)
834+ (assoc-in [ch :joining?] true)))
835+ (irc/join! c ch)))
836+
801837 (defn apply-msg!
802838 "Fold one parsed IRC message into the state."
803839 [msg]
804840 (let [{:keys [command params prefix]} msg
805841 from (irc/nick-of prefix)]
842+ (when (and @policy-asking (not= command "NOTICE"))
843+ (reset! policy-asking nil))
806844 (case command
807845 "001" (do (reset! status (if @session
808846 (str "Connected as " (:handle @session))
@@ -920,7 +958,10 @@
920958 (let [fresh? (empty? (get-in @channels [ch :messages]))]
921959 (swap! channels #(-> (ensure-channel % ch)
922960 (assoc-in [ch :joined?] true)
923- (assoc-in [ch :joining?] false)))
961+ (assoc-in [ch :joining?] false)
962+ ;; In the room: whatever it was asking
963+ ;; for, it is not asking any more.
964+ (assoc-in [ch :policy-required?] false)))
924965 ;; Only on the way in to an empty buffer. A reconnect joins
925966 ;; every channel again, and saying so on top of the backlog
926967 ;; already there is just a second line of noise.
@@ -996,7 +1037,12 @@
9961037 "MODE" (let [[target modes & args] params]
9971038 (when (str/starts-with? (or target "") "#")
9981039 (apply-mode! target modes args)))
999- ("NOTICE" "372" "375" "376" "002" "003" "004")
1040+ "NOTICE"
1041+ (if-let [ch @policy-asking]
1042+ (swap! channels #(update-in (ensure-channel % ch) [ch :policy-text]
1043+ (fnil conj []) (str/trimr (or (last params) ""))))
1044+ (reset! status (or (last params) @status)))
1045+ ("372" "375" "376" "002" "003" "004")
10001046 (reset! status (or (last params) @status))
10011047 ;; 473 invite-only, 474 banned, 475 keyed, 477 needs registration,
10021048 ;; 471 full, 403 no such channel. The channel is params[1]; clearing its
@@ -1008,7 +1054,14 @@
10081054 (swap! channels #(-> (ensure-channel % ch)
10091055 (assoc-in [ch :joined?] false)
10101056 (assoc-in [ch :joining?] false)))
1011- (push-message! ch "*" (str "Could not join " ch "" why)))
1057+ (push-message! ch "*" (str "Could not join " ch "" why))
1058+ ;; The one refusal the reader can answer themselves: the room is not
1059+ ;; shut to them, it is waiting on them to say yes to something. The
1060+ ;; flag is what puts the Accept button in the channel, and the rules
1061+ ;; are asked for so it is not a yes to an unread page.
1062+ (when (str/includes? (str/lower-case (or why "")) "policy")
1063+ (swap! channels #(assoc-in % [ch :policy-required?] true))
1064+ (ask-policy! ch)))
10121065 ;; Deliberately not the global banner: it outlives the screen it was
10131066 ;; about, and the reason is in the channel's own buffer where it
10141067 ;; belongs. The banner is for what stops the whole app a failed
@@ -1530,6 +1583,19 @@
15301583 {:keys [url status path] :as att} @attachment]
15311584 (cond
15321585 (not target) nil
1586+ ;; A line beginning with "/" is said to the server, not to the room:
1587+ ;; POLICY, MODE, whatever the server asks for by name. Without it a
1588+ ;; channel that answers a JOIN with "use POLICY <channel> ACCEPT" is one
1589+ ;; the reader can see the instructions for and has no way to follow.
1590+ ;; "//" is how you say a line that really does start with a slash.
1591+ (and (str/starts-with? text "/") (not (str/starts-with? text "//")))
1592+ (if-let [c @conn]
1593+ (let [line (str/trim (subs text 1))]
1594+ (when (seq line)
1595+ (irc/send-line! c line)
1596+ (push-message! target "*" (str "> " line)))
1597+ (reset! draft ""))
1598+ (reset! error "Not connected."))
15331599 (= :uploading status) (reset! error "The picture is still uploading.")
15341600 ;; A rewrite replaces what was said, and what was said is a line of text:
15351601 ;; there is no wire form for adding a picture to a message already sent,
@@ -1550,7 +1616,8 @@
15501616 (reset! draft ""))
15511617 (and (str/blank? text) (not url)) nil
15521618 :else
1553- (let [line (str/trim (str text (when url (str " " url))))]
1619+ (let [text (if (str/starts-with? text "//") (subs text 1) text)
1620+ line (str/trim (str text (when url (str " " url))))]
15541621 ;; Saying something is a way of asking to see it.
15551622 (jump-to-present!)
15561623 (when-let [c @conn] (irc/privmsg! c target line (:id reply-to)))
@@ -798,11 +798,49 @@
798 (= session-id (:session-id lc))))798 (= session-id (:session-id lc))))
799 (av/stop-media!))))))799 (av/stop-media!))))))
800 800
801+;; Which channel's POLICY reply is outstanding, or nil. The server answers
802+;; POLICY with a run of NOTICEs addressed to our nick and naming no channel;
803+;; without this they land in the status banner one at a time, and the rules
804+;; the reader is being asked to accept are never readable.
805+;;
806+;; ponytail: the run ends at the first line that is not a NOTICE, so a PING
807+;; landing mid-answer truncates the rules. A reply-tag or a POLICY numeric
808+;; from the server would end it properly.
809+(defonce ^:private policy-asking (atom nil))
810+
811+(defn ask-policy!
812+ "Ask the server what this channel's policy says, so the reader can read what
813+ they are being asked to accept.
814+
815+ The answer comes back as plain NOTICEs to our nick, naming no channel so
816+ the question is remembered here, and the lines that follow it are filed
817+ under the channel that asked."
818+ [ch]
819+ (swap! channels #(assoc-in (ensure-channel % ch) [ch :policy-text] []))
820+ (reset! policy-asking ch)
821+ (when-let [c @conn]
822+ (irc/send-line! c (str "POLICY " ch " RULES"))
823+ (irc/send-line! c (str "POLICY " ch " INFO"))))
824+
825+(defn accept-policy!
826+ "Accept the channel's policy and go back in. The JOIN follows immediately:
827+ accepting is only ever done in order to be in the room, and the server takes
828+ the two in the order they are sent."
829+ [ch]
830+ (when-let [c @conn]
831+ (irc/send-line! c (str "POLICY " ch " ACCEPT"))
832+ (swap! channels #(-> (ensure-channel % ch)
833+ (assoc-in [ch :policy-required?] false)
834+ (assoc-in [ch :joining?] true)))
835+ (irc/join! c ch)))
836+
801 (defn apply-msg!837 (defn apply-msg!
802 "Fold one parsed IRC message into the state."838 "Fold one parsed IRC message into the state."
803 [msg]839 [msg]
804 (let [{:keys [command params prefix]} msg840 (let [{:keys [command params prefix]} msg
805 from (irc/nick-of prefix)]841 from (irc/nick-of prefix)]
842+ (when (and @policy-asking (not= command "NOTICE"))
843+ (reset! policy-asking nil))
806 (case command844 (case command
807 "001" (do (reset! status (if @session845 "001" (do (reset! status (if @session
808 (str "Connected as " (:handle @session))846 (str "Connected as " (:handle @session))
@@ -920,7 +958,10 @@
920 (let [fresh? (empty? (get-in @channels [ch :messages]))]958 (let [fresh? (empty? (get-in @channels [ch :messages]))]
921 (swap! channels #(-> (ensure-channel % ch)959 (swap! channels #(-> (ensure-channel % ch)
922 (assoc-in [ch :joined?] true)960 (assoc-in [ch :joined?] true)
923- (assoc-in [ch :joining?] false)))961+ (assoc-in [ch :joining?] false)
962+ ;; In the room: whatever it was asking
963+ ;; for, it is not asking any more.
964+ (assoc-in [ch :policy-required?] false)))
924 ;; Only on the way in to an empty buffer. A reconnect joins965 ;; Only on the way in to an empty buffer. A reconnect joins
925 ;; every channel again, and saying so on top of the backlog966 ;; every channel again, and saying so on top of the backlog
926 ;; already there is just a second line of noise.967 ;; already there is just a second line of noise.
@@ -996,7 +1037,12 @@
996 "MODE" (let [[target modes & args] params]1037 "MODE" (let [[target modes & args] params]
997 (when (str/starts-with? (or target "") "#")1038 (when (str/starts-with? (or target "") "#")
998 (apply-mode! target modes args)))1039 (apply-mode! target modes args)))
999- ("NOTICE" "372" "375" "376" "002" "003" "004")1040+ "NOTICE"
1041+ (if-let [ch @policy-asking]
1042+ (swap! channels #(update-in (ensure-channel % ch) [ch :policy-text]
1043+ (fnil conj []) (str/trimr (or (last params) ""))))
1044+ (reset! status (or (last params) @status)))
1045+ ("372" "375" "376" "002" "003" "004")
1000 (reset! status (or (last params) @status))1046 (reset! status (or (last params) @status))
1001 ;; 473 invite-only, 474 banned, 475 keyed, 477 needs registration,1047 ;; 473 invite-only, 474 banned, 475 keyed, 477 needs registration,
1002 ;; 471 full, 403 no such channel. The channel is params[1]; clearing its1048 ;; 471 full, 403 no such channel. The channel is params[1]; clearing its
@@ -1008,7 +1054,14 @@
1008 (swap! channels #(-> (ensure-channel % ch)1054 (swap! channels #(-> (ensure-channel % ch)
1009 (assoc-in [ch :joined?] false)1055 (assoc-in [ch :joined?] false)
1010 (assoc-in [ch :joining?] false)))1056 (assoc-in [ch :joining?] false)))
1011- (push-message! ch "*" (str "Could not join " ch "" why)))1057+ (push-message! ch "*" (str "Could not join " ch "" why))
1058+ ;; The one refusal the reader can answer themselves: the room is not
1059+ ;; shut to them, it is waiting on them to say yes to something. The
1060+ ;; flag is what puts the Accept button in the channel, and the rules
1061+ ;; are asked for so it is not a yes to an unread page.
1062+ (when (str/includes? (str/lower-case (or why "")) "policy")
1063+ (swap! channels #(assoc-in % [ch :policy-required?] true))
1064+ (ask-policy! ch)))
1012 ;; Deliberately not the global banner: it outlives the screen it was1065 ;; Deliberately not the global banner: it outlives the screen it was
1013 ;; about, and the reason is in the channel's own buffer where it1066 ;; about, and the reason is in the channel's own buffer where it
1014 ;; belongs. The banner is for what stops the whole app a failed1067 ;; belongs. The banner is for what stops the whole app a failed
@@ -1530,6 +1583,19 @@
1530 {:keys [url status path] :as att} @attachment]1583 {:keys [url status path] :as att} @attachment]
1531 (cond1584 (cond
1532 (not target) nil1585 (not target) nil
1586+ ;; A line beginning with "/" is said to the server, not to the room:
1587+ ;; POLICY, MODE, whatever the server asks for by name. Without it a
1588+ ;; channel that answers a JOIN with "use POLICY <channel> ACCEPT" is one
1589+ ;; the reader can see the instructions for and has no way to follow.
1590+ ;; "//" is how you say a line that really does start with a slash.
1591+ (and (str/starts-with? text "/") (not (str/starts-with? text "//")))
1592+ (if-let [c @conn]
1593+ (let [line (str/trim (subs text 1))]
1594+ (when (seq line)
1595+ (irc/send-line! c line)
1596+ (push-message! target "*" (str "> " line)))
1597+ (reset! draft ""))
1598+ (reset! error "Not connected."))
1533 (= :uploading status) (reset! error "The picture is still uploading.")1599 (= :uploading status) (reset! error "The picture is still uploading.")
1534 ;; A rewrite replaces what was said, and what was said is a line of text:1600 ;; A rewrite replaces what was said, and what was said is a line of text:
1535 ;; there is no wire form for adding a picture to a message already sent,1601 ;; there is no wire form for adding a picture to a message already sent,
@@ -1550,7 +1616,8 @@
1550 (reset! draft ""))1616 (reset! draft ""))
1551 (and (str/blank? text) (not url)) nil1617 (and (str/blank? text) (not url)) nil
1552 :else1618 :else
1553- (let [line (str/trim (str text (when url (str " " url))))]1619+ (let [text (if (str/starts-with? text "//") (subs text 1) text)
1620+ line (str/trim (str text (when url (str " " url))))]
1554 ;; Saying something is a way of asking to see it.1621 ;; Saying something is a way of asking to see it.
1555 (jump-to-present!)1622 (jump-to-present!)
1556 (when-let [c @conn] (irc/privmsg! c target line (:id reply-to)))1623 (when-let [c @conn] (irc/privmsg! c target line (:id reply-to)))