rickub
Sign in Get started
nandi/frqpublic⑂ Fork 0
⑂ 8a491ba
Branches
claude/add-remote-repository-47d12e main View all branches → View all tags →
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.

Send a picture by pasting it

IRC carries text, so sharing a picture has always meant uploading it somewhere
and sending the link — work this client left to the reader and whatever other
tool they had to hand.

Ctrl+V in the draft now does it. The picture on the clipboard is written out as
a PNG, uploaded to freeq's media endpoint while the line it goes with is being
written, and turned into a link only on the way out. Until then it is a picture:
shown under the box, with an ✕ to drop it, rather than a URL pasted into the
middle of what someone was typing.

The upload is authorised by the connection itself — the endpoint takes a DID
with a live session — so it is for signed-in users, and desktop only, since the
clipboard is read through the ABI and Android has no picture on one to read. A
send while the upload is still going is held rather than sent without it.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
nandi committed 2026-08-30T13:55:19-07:00 Browse files
8a491ba parent: bcc2876
modified README.md +13 -0
@@ -17,6 +17,7 @@ src/frq/oauth.jolt the broker flow: login URL, loopback capture, /session
1717 src/frq/store.jolt the saved sign-in, mode 600 in the config directory
1818 src/frq/avatars.jolt profile pictures, by DID or handle
1919 src/frq/media.jolt image links: spot them, fetch them once, cache on disk
20+src/frq/upload.jolt a pasted picture to freeq's media endpoint, as multipart
2021 src/frq/clock.jolt the reader's own zone, twelve-hour times, day headings
2122 src/frq/emoji.jolt the picker's catalog: every drawable emoji and its name
2223 src/frq/irc.jolt IRC over TLS or TCP: parser, reader thread, SASL, PRIVMSG
@@ -118,6 +119,12 @@ surface — that surface does not work on Android either, while the syscalls do.
118119 backlog comes back
119120 * Inline previews for PNG links, fetched once and cached under
120121 `$XDG_CACHE_HOME/frq/media`; click one to see it full size
122+* Ctrl+V in the draft attaches the picture on the clipboard: it is previewed
123+ under the box and uploaded to freeq's media endpoint while you write the line
124+ it goes with, and only on the way out does it become the link — which is the
125+ whole of what sending an image over IRC means. The draft itself is never
126+ written into. Text pastes as text, as it always did: the picture path is the
127+ keystroke the field had no text to answer with
121128 * Join/part notices, DMs bucketed under the sender's nick
122129 * Discover list, search over buffers, disconnect
123130 * The rooms you have opened, remembered across runs and listed in the order
@@ -138,6 +145,12 @@ surface — that surface does not work on Android either, while the syscalls do.
138145 format, and a fetch needs TLS, so the phone shows links. The link is left in
139146 place either way.
140147 * **Nothing evicts the media cache.**
148+* **Pasting a picture needs a sign-in and a desktop.** The upload is filed
149+ under the DID of a live session, so a guest cannot make one; and it is read
150+ off the clipboard through the ABI's `vidya_clipboard_image_png`, which
151+ arboard backs on desktop and nothing backs on Android. It also shares
152+ nothing to your PDS and posts nothing to Bluesky — those fields are opt-in
153+ and this client does not send them.
141154 * **No scrollback trimming, reactions, threads, or calls.**
142155 * A sent line waits up to 200ms for the reader thread to flush it.
143156 * Message lists are keyed vboxes; glimmer-vidya has no `:listbox` yet.
@@ -17,6 +17,7 @@ src/frq/oauth.jolt the broker flow: login URL, loopback capture, /session
17 src/frq/store.jolt the saved sign-in, mode 600 in the config directory17 src/frq/store.jolt the saved sign-in, mode 600 in the config directory
18 src/frq/avatars.jolt profile pictures, by DID or handle18 src/frq/avatars.jolt profile pictures, by DID or handle
19 src/frq/media.jolt image links: spot them, fetch them once, cache on disk19 src/frq/media.jolt image links: spot them, fetch them once, cache on disk
20+src/frq/upload.jolt a pasted picture to freeq's media endpoint, as multipart
20 src/frq/clock.jolt the reader's own zone, twelve-hour times, day headings21 src/frq/clock.jolt the reader's own zone, twelve-hour times, day headings
21 src/frq/emoji.jolt the picker's catalog: every drawable emoji and its name22 src/frq/emoji.jolt the picker's catalog: every drawable emoji and its name
22 src/frq/irc.jolt IRC over TLS or TCP: parser, reader thread, SASL, PRIVMSG23 src/frq/irc.jolt IRC over TLS or TCP: parser, reader thread, SASL, PRIVMSG
@@ -118,6 +119,12 @@ surface — that surface does not work on Android either, while the syscalls do.
118 backlog comes back119 backlog comes back
119 * Inline previews for PNG links, fetched once and cached under120 * Inline previews for PNG links, fetched once and cached under
120 `$XDG_CACHE_HOME/frq/media`; click one to see it full size121 `$XDG_CACHE_HOME/frq/media`; click one to see it full size
122+* Ctrl+V in the draft attaches the picture on the clipboard: it is previewed
123+ under the box and uploaded to freeq's media endpoint while you write the line
124+ it goes with, and only on the way out does it become the link — which is the
125+ whole of what sending an image over IRC means. The draft itself is never
126+ written into. Text pastes as text, as it always did: the picture path is the
127+ keystroke the field had no text to answer with
121 * Join/part notices, DMs bucketed under the sender's nick128 * Join/part notices, DMs bucketed under the sender's nick
122 * Discover list, search over buffers, disconnect129 * Discover list, search over buffers, disconnect
123 * The rooms you have opened, remembered across runs and listed in the order130 * The rooms you have opened, remembered across runs and listed in the order
@@ -138,6 +145,12 @@ surface — that surface does not work on Android either, while the syscalls do.
138 format, and a fetch needs TLS, so the phone shows links. The link is left in145 format, and a fetch needs TLS, so the phone shows links. The link is left in
139 place either way.146 place either way.
140 * **Nothing evicts the media cache.**147 * **Nothing evicts the media cache.**
148+* **Pasting a picture needs a sign-in and a desktop.** The upload is filed
149+ under the DID of a live session, so a guest cannot make one; and it is read
150+ off the clipboard through the ABI's `vidya_clipboard_image_png`, which
151+ arboard backs on desktop and nothing backs on Android. It also shares
152+ nothing to your PDS and posts nothing to Bluesky — those fields are opt-in
153+ and this client does not send them.
141 * **No scrollback trimming, reactions, threads, or calls.**154 * **No scrollback trimming, reactions, threads, or calls.**
142 * A sent line waits up to 200ms for the reader thread to flush it.155 * A sent line waits up to 200ms for the reader thread to flush it.
143 * Message lists are keyed vboxes; glimmer-vidya has no `:listbox` yet.156 * Message lists are keyed vboxes; glimmer-vidya has no `:listbox` yet.
modified src/frq/app.jolt +48 -19
@@ -486,22 +486,22 @@
486486 messages))
487487
488488 (defn lightbox-screen
489- "One picture, as big as the window allows.
489+ "One picture, as big as the window will paint it.
490490
491- A screen rather than an overlay: the tree backend paints in one layer and
492- has no z-order to put something on top of everything else with."
491+ A screen rather than an overlay: the tree backend paints in one layer and has
492+ no z-order to put something on top of everything else with. So the picture
493+ takes the window — `:fit` gives it every point below the one row that is not
494+ it, centred and in proportion, scaled up as readily as down.
495+
496+ That row is the way back. Clicking the picture closes it too — the same
497+ gesture that opened it — but a way out you have to guess at is not one, and
498+ the row costs the picture a line."
493499 []
494- (let [{:keys [path url]} @s/lightbox]
495- [:vbox {:spacing 8 :margin 12}
500+ (let [{:keys [path]} @s/lightbox]
501+ [:vbox {:spacing 4 :margin 4}
496502 [:hbox {:spacing 8}
497- [:button {:label "← Back" :on-click #(reset! s/lightbox nil)}]
498- [:dim-label {:label url}]]
499- ;; A picture fits the window's width, and a tall one is then taller than
500- ;; the window — so it scrolls. No `:reserve`: nothing follows it here, so
501- ;; the rest of the window is the picture's to use.
502- [:scroll {:orientation :vertical}
503- ;; Clicking the picture closes it too — the same gesture that opened it.
504- [:image {:src path :max-height 20000 :on-click #(reset! s/lightbox nil)}]]]))
503+ [:button {:label "← Back" :on-click #(reset! s/lightbox nil)}]]
504+ [:image {:src path :fit true :on-click #(reset! s/lightbox nil)}]]))
505505
506506 (defn chat-screen []
507507 (let [name @s/current
@@ -521,12 +521,21 @@
521521 ;; is showing, and neither does that row — a reserve that changed would
522522 ;; move the compose bar under the reader every time the button came and
523523 ;; went.
524- [:scroll {:orientation :vertical
525- ;; Plus the reply banner's row when there is one. That row does
526- ;; move the compose bar, and should: it appears because the
527- ;; reader asked to answer something, unlike the jump button,
528- ;; which appears on its own and must not shift what is under it.
529- :reserve (if @s/replying-to 150 116)
524+ ;; Named, so the list is the same list when the reader comes back to it.
525+ ;; The lightbox is a screen rather than a layer, so looking at a picture
526+ ;; unmounts the backlog behind it; without a name of its own the position
527+ ;; would come back as a fresh one, and ← Back would answer a click on a
528+ ;; message halfway up a week of history with the top of the buffer.
529+ [:scroll {:scroll-key "chat-messages"
530+ :orientation :vertical
531+ ;; Plus the reply banner's row when there is one, and the
532+ ;; pasted picture when there is one. Those rows do move the
533+ ;; compose bar, and should: each appears because the reader just
534+ ;; asked for something — unlike the jump button, which appears
535+ ;; on its own and must not shift what is under it.
536+ :reserve (+ 116
537+ (if @s/replying-to 34 0)
538+ (if @s/attachment 76 0))
530539 :stick-to-bottom true
531540 :scroll-to-bottom @s/jump-tick
532541 :on-change #(reset! s/at-present? (= "end" %))}
@@ -548,12 +557,32 @@
548557 [:hbox {:spacing 8}
549558 [:dim-label {:label (str "↩ " (:from target) ": " (summarise target 36))}]
550559 [:button {:label "✕" :on-click s/cancel-reply!}]])]
560+ ;; The pasted picture, above the line it will go out with. Shown rather
561+ ;; than written into the draft: what is being sent is a picture, and a URL
562+ ;; dropped into the entry would be an unreadable line of text sitting in
563+ ;; the middle of whatever the reader was in the middle of typing.
564+ [:vbox {:key :attachment}
565+ (when-let [att @s/attachment]
566+ [:hbox {:spacing 8}
567+ ;; Small: it is a reminder of what is attached, not the picture
568+ ;; itself, and the backlog above it is what the reader is here for.
569+ [:image {:src (:path att) :max-height 64}]
570+ [:dim-label {:label (if (= :uploading (:status att))
571+ "Uploading…"
572+ "Picture attached")}]
573+ [:button {:label "✕" :on-click s/clear-attachment!}]])]
551574 [:hbox {:spacing 8}
552575 ;; narrow enough that Send keeps its place on a phone-width row
576+ ;; A picture is pasted where everything else is typed: Ctrl+V. The field
577+ ;; answers a paste of text with the text, and one of a picture reaches
578+ ;; `:on-paste-empty` — a keystroke the field had nothing to put in
579+ ;; itself, which is exactly the one that means "the clipboard has
580+ ;; something else on it".
553581 [:entry {:text @s/draft
554582 :width-request 300
555583 :placeholder "Message"
556584 :on-change #(reset! s/draft %)
585+ :on-paste-empty s/paste-image!
557586 :on-activate s/send-draft!}]
558587 [:button {:label "Send" :kind :primary :on-click s/send-draft!}]]]))
559588
@@ -486,22 +486,22 @@
486 messages))486 messages))
487 487
488 (defn lightbox-screen488 (defn lightbox-screen
489- "One picture, as big as the window allows.489+ "One picture, as big as the window will paint it.
490 490
491- A screen rather than an overlay: the tree backend paints in one layer and491+ A screen rather than an overlay: the tree backend paints in one layer and has
492- has no z-order to put something on top of everything else with."492+ no z-order to put something on top of everything else with. So the picture
493+ takes the window — `:fit` gives it every point below the one row that is not
494+ it, centred and in proportion, scaled up as readily as down.
495+
496+ That row is the way back. Clicking the picture closes it too — the same
497+ gesture that opened it — but a way out you have to guess at is not one, and
498+ the row costs the picture a line."
493 []499 []
494- (let [{:keys [path url]} @s/lightbox]500+ (let [{:keys [path]} @s/lightbox]
495- [:vbox {:spacing 8 :margin 12}501+ [:vbox {:spacing 4 :margin 4}
496 [:hbox {:spacing 8}502 [:hbox {:spacing 8}
497- [:button {:label "← Back" :on-click #(reset! s/lightbox nil)}]503+ [:button {:label "← Back" :on-click #(reset! s/lightbox nil)}]]
498- [:dim-label {:label url}]]504+ [:image {:src path :fit true :on-click #(reset! s/lightbox nil)}]]))
499- ;; A picture fits the window's width, and a tall one is then taller than
500- ;; the window — so it scrolls. No `:reserve`: nothing follows it here, so
501- ;; the rest of the window is the picture's to use.
502- [:scroll {:orientation :vertical}
503- ;; Clicking the picture closes it too — the same gesture that opened it.
504- [:image {:src path :max-height 20000 :on-click #(reset! s/lightbox nil)}]]]))
505 505
506 (defn chat-screen []506 (defn chat-screen []
507 (let [name @s/current507 (let [name @s/current
@@ -521,12 +521,21 @@
521 ;; is showing, and neither does that row — a reserve that changed would521 ;; is showing, and neither does that row — a reserve that changed would
522 ;; move the compose bar under the reader every time the button came and522 ;; move the compose bar under the reader every time the button came and
523 ;; went.523 ;; went.
524- [:scroll {:orientation :vertical524+ ;; Named, so the list is the same list when the reader comes back to it.
525- ;; Plus the reply banner's row when there is one. That row does525+ ;; The lightbox is a screen rather than a layer, so looking at a picture
526- ;; move the compose bar, and should: it appears because the526+ ;; unmounts the backlog behind it; without a name of its own the position
527- ;; reader asked to answer something, unlike the jump button,527+ ;; would come back as a fresh one, and ← Back would answer a click on a
528- ;; which appears on its own and must not shift what is under it.528+ ;; message halfway up a week of history with the top of the buffer.
529- :reserve (if @s/replying-to 150 116)529+ [:scroll {:scroll-key "chat-messages"
530+ :orientation :vertical
531+ ;; Plus the reply banner's row when there is one, and the
532+ ;; pasted picture when there is one. Those rows do move the
533+ ;; compose bar, and should: each appears because the reader just
534+ ;; asked for something — unlike the jump button, which appears
535+ ;; on its own and must not shift what is under it.
536+ :reserve (+ 116
537+ (if @s/replying-to 34 0)
538+ (if @s/attachment 76 0))
530 :stick-to-bottom true539 :stick-to-bottom true
531 :scroll-to-bottom @s/jump-tick540 :scroll-to-bottom @s/jump-tick
532 :on-change #(reset! s/at-present? (= "end" %))}541 :on-change #(reset! s/at-present? (= "end" %))}
@@ -548,12 +557,32 @@
548 [:hbox {:spacing 8}557 [:hbox {:spacing 8}
549 [:dim-label {:label (str "↩ " (:from target) ": " (summarise target 36))}]558 [:dim-label {:label (str "↩ " (:from target) ": " (summarise target 36))}]
550 [:button {:label "✕" :on-click s/cancel-reply!}]])]559 [:button {:label "✕" :on-click s/cancel-reply!}]])]
560+ ;; The pasted picture, above the line it will go out with. Shown rather
561+ ;; than written into the draft: what is being sent is a picture, and a URL
562+ ;; dropped into the entry would be an unreadable line of text sitting in
563+ ;; the middle of whatever the reader was in the middle of typing.
564+ [:vbox {:key :attachment}
565+ (when-let [att @s/attachment]
566+ [:hbox {:spacing 8}
567+ ;; Small: it is a reminder of what is attached, not the picture
568+ ;; itself, and the backlog above it is what the reader is here for.
569+ [:image {:src (:path att) :max-height 64}]
570+ [:dim-label {:label (if (= :uploading (:status att))
571+ "Uploading…"
572+ "Picture attached")}]
573+ [:button {:label "✕" :on-click s/clear-attachment!}]])]
551 [:hbox {:spacing 8}574 [:hbox {:spacing 8}
552 ;; narrow enough that Send keeps its place on a phone-width row575 ;; narrow enough that Send keeps its place on a phone-width row
576+ ;; A picture is pasted where everything else is typed: Ctrl+V. The field
577+ ;; answers a paste of text with the text, and one of a picture reaches
578+ ;; `:on-paste-empty` — a keystroke the field had nothing to put in
579+ ;; itself, which is exactly the one that means "the clipboard has
580+ ;; something else on it".
553 [:entry {:text @s/draft581 [:entry {:text @s/draft
554 :width-request 300582 :width-request 300
555 :placeholder "Message"583 :placeholder "Message"
556 :on-change #(reset! s/draft %)584 :on-change #(reset! s/draft %)
585+ :on-paste-empty s/paste-image!
557 :on-activate s/send-draft!}]586 :on-activate s/send-draft!}]
558 [:button {:label "Send" :kind :primary :on-click s/send-draft!}]]]))587 [:button {:label "Send" :kind :primary :on-click s/send-draft!}]]]))
559 588
modified src/frq/state.jolt +117 -12
@@ -6,6 +6,7 @@
66 is the only place a wire message turns into UI state."
77 (:require [clojure.string :as str]
88 [glimmer.ratom :as r :refer [atom]]
9+ [jolt.host :as host]
910 [frq.atproto :as atproto]
1011 [frq.clock :as clock]
1112 [frq.emoji :as emoji]
@@ -13,7 +14,9 @@
1314 [frq.avatars :as avatars]
1415 [frq.media :as media]
1516 [frq.oauth :as oauth]
16- [frq.store :as store]))
17+ [frq.store :as store]
18+ [frq.upload :as upload]
19+ [glimmer-vidya.core :as vidya]))
1720
1821 (def default-host "irc.freeq.at")
1922 (def default-port "6697")
@@ -512,19 +515,121 @@
512515 (when (seq ch)
513516 (open-channel! ch))))
514517
515-(defn send-draft! []
518+;; ------------------------------------------------------------------ pasting
519+
520+;; The picture waiting to go out with the next line, or nil:
521+;;
522+;; {:path the copy on disk, which is what the preview paints
523+;; :url where freeq serves it, once the upload has landed
524+;; :status :uploading | :ready}
525+;;
526+;; Held apart from the draft rather than written into it. A link pasted into
527+;; the entry is a line of unreadable text in the middle of whatever the reader
528+;; was typing, and it puts their cursor somewhere they did not put it. The
529+;; picture is a picture until it is sent; the draft stays theirs.
530+;;
531+;; One at a time — a second paste replaces the first, which is what a reader
532+;; who pasted the wrong thing means by pasting the right one.
533+(defonce attachment (atom nil))
534+
535+;; Each paste gets a file of its own rather than overwriting the last: the
536+;; preview is painted from the file, and an upload may still be reading it.
537+(defonce ^:private paste-count (atom 0))
538+
539+(defn- paste-path []
540+ (let [n (swap! paste-count inc)]
541+ (str (media/cache-dir) "/outgoing/paste-" n ".png")))
542+
543+(defn- discard-file!
544+ "Drop a paste's copy on disk. Nothing else keeps it: the picture that matters
545+ after sending is the one the server serves back, which the media cache
546+ fetches like any other."
547+ [path]
548+ (when path (try (host/delete-file! path) (catch Exception _ nil))))
549+
550+(defn clear-attachment!
551+ "Drop the pasted picture without sending it."
552+ []
553+ (when-let [a @attachment]
554+ (reset! attachment nil)
555+ (discard-file! (:path a))))
556+
557+(defn paste-image!
558+ "Take the picture on the clipboard and hold it against the next line.
559+
560+ IRC has nowhere to put an image, so a link is the whole of what sending one
561+ means — but that is a fact about the wire, not something the reader should
562+ have to type around. The picture is attached: shown under the draft while
563+ they write whatever they are sending it with, and turned into a link only on
564+ the way out.
565+
566+ The upload runs off the UI thread and starts at once rather than at send, so
567+ by the time a line is written the picture is usually already up. A failure
568+ lands in `error` like any other, and takes the attachment with it — there is
569+ nothing to send and nothing to show."
570+ []
571+ (let [path (paste-path)]
572+ (host/mkdirs! (str (media/cache-dir) "/outgoing"))
573+ (if-not (vidya/clipboard-image-png! path)
574+ (reset! error "No picture on the clipboard.")
575+ (let [did (:did @session)
576+ host-name @form-host
577+ channel @current]
578+ (reset! error nil)
579+ (clear-attachment!)
580+ (reset! attachment {:path path :status :uploading})
581+ (future
582+ (try
583+ (let [url (upload/upload! host-name did channel path "paste.png")]
584+ ;; Only if this is still the paste on screen: a reader who
585+ ;; pasted again, or cleared it, has said what they want, and an
586+ ;; upload landing afterwards does not get to undo that.
587+ (swap! attachment #(if (= (:path %) path)
588+ (assoc % :url url :status :ready)
589+ %))
590+ (when-not (= (:path @attachment) path) (discard-file! path)))
591+ (catch Exception e
592+ (swap! attachment #(if (= (:path %) path) nil %))
593+ (discard-file! path)
594+ (reset! error (or (ex-message e) (str e))))))))))
595+
596+(defn send-draft!
597+ "Send the draft, with whatever picture is attached to it.
598+
599+ The picture becomes its link, at the end of the line: what goes on the wire
600+ is the text the reader wrote and a URL after it, which is what every other
601+ client in the channel knows how to show. A line that is only a picture is
602+ only the link.
603+
604+ A picture still on its way up holds the send rather than losing it: the line
605+ is left in the box, said so, and the reader presses send again a moment
606+ later. Sending the text without its picture would be the one outcome nobody
607+ asked for."
608+ []
516609 (let [text (str/trim @draft)
517610 target @current
518- reply-to @replying-to]
519- (when (and (seq text) target)
520- ;; Saying something is a way of asking to see it.
521- (jump-to-present!)
522- (when-let [c @conn] (irc/privmsg! c target text (:id reply-to)))
523- ;; The local echo carries the same link, so the chip is there before the
524- ;; server's copy of the line comes back — if it ever does.
525- (push-message! target @form-nick text {:reply-to (:id reply-to)})
526- (reset! replying-to nil)
527- (reset! draft ""))))
611+ reply-to @replying-to
612+ {:keys [url status path] :as att} @attachment]
613+ (cond
614+ (not target) nil
615+ (= :uploading status) (reset! error "The picture is still uploading.")
616+ (and (str/blank? text) (not url)) nil
617+ :else
618+ (let [line (str/trim (str text (when url (str " " url))))]
619+ ;; Saying something is a way of asking to see it.
620+ (jump-to-present!)
621+ (when-let [c @conn] (irc/privmsg! c target line (:id reply-to)))
622+ ;; The local echo carries the same link, so the chip is there before
623+ ;; the server's copy of the line comes back — if it ever does.
624+ (push-message! target @form-nick line {:reply-to (:id reply-to)})
625+ (reset! replying-to nil)
626+ (reset! draft "")
627+ (when att
628+ (reset! attachment nil)
629+ ;; The picture on screen from here on is the one fetched back from
630+ ;; the link, like everyone else's.
631+ (discard-file! path))))))
632+
528633
529634 (defn open-picker!
530635 "Choose an emoji for this message. Opening it fresh — no leftover search from
@@ -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 [glimmer.ratom :as r :refer [atom]]8 [glimmer.ratom :as r :refer [atom]]
9+ [jolt.host :as host]
9 [frq.atproto :as atproto]10 [frq.atproto :as atproto]
10 [frq.clock :as clock]11 [frq.clock :as clock]
11 [frq.emoji :as emoji]12 [frq.emoji :as emoji]
@@ -13,7 +14,9 @@
13 [frq.avatars :as avatars]14 [frq.avatars :as avatars]
14 [frq.media :as media]15 [frq.media :as media]
15 [frq.oauth :as oauth]16 [frq.oauth :as oauth]
16- [frq.store :as store]))17+ [frq.store :as store]
18+ [frq.upload :as upload]
19+ [glimmer-vidya.core :as vidya]))
17 20
18 (def default-host "irc.freeq.at")21 (def default-host "irc.freeq.at")
19 (def default-port "6697")22 (def default-port "6697")
@@ -512,19 +515,121 @@
512 (when (seq ch)515 (when (seq ch)
513 (open-channel! ch))))516 (open-channel! ch))))
514 517
515-(defn send-draft! []518+;; ------------------------------------------------------------------ pasting
519+
520+;; The picture waiting to go out with the next line, or nil:
521+;;
522+;; {:path the copy on disk, which is what the preview paints
523+;; :url where freeq serves it, once the upload has landed
524+;; :status :uploading | :ready}
525+;;
526+;; Held apart from the draft rather than written into it. A link pasted into
527+;; the entry is a line of unreadable text in the middle of whatever the reader
528+;; was typing, and it puts their cursor somewhere they did not put it. The
529+;; picture is a picture until it is sent; the draft stays theirs.
530+;;
531+;; One at a time — a second paste replaces the first, which is what a reader
532+;; who pasted the wrong thing means by pasting the right one.
533+(defonce attachment (atom nil))
534+
535+;; Each paste gets a file of its own rather than overwriting the last: the
536+;; preview is painted from the file, and an upload may still be reading it.
537+(defonce ^:private paste-count (atom 0))
538+
539+(defn- paste-path []
540+ (let [n (swap! paste-count inc)]
541+ (str (media/cache-dir) "/outgoing/paste-" n ".png")))
542+
543+(defn- discard-file!
544+ "Drop a paste's copy on disk. Nothing else keeps it: the picture that matters
545+ after sending is the one the server serves back, which the media cache
546+ fetches like any other."
547+ [path]
548+ (when path (try (host/delete-file! path) (catch Exception _ nil))))
549+
550+(defn clear-attachment!
551+ "Drop the pasted picture without sending it."
552+ []
553+ (when-let [a @attachment]
554+ (reset! attachment nil)
555+ (discard-file! (:path a))))
556+
557+(defn paste-image!
558+ "Take the picture on the clipboard and hold it against the next line.
559+
560+ IRC has nowhere to put an image, so a link is the whole of what sending one
561+ means — but that is a fact about the wire, not something the reader should
562+ have to type around. The picture is attached: shown under the draft while
563+ they write whatever they are sending it with, and turned into a link only on
564+ the way out.
565+
566+ The upload runs off the UI thread and starts at once rather than at send, so
567+ by the time a line is written the picture is usually already up. A failure
568+ lands in `error` like any other, and takes the attachment with it — there is
569+ nothing to send and nothing to show."
570+ []
571+ (let [path (paste-path)]
572+ (host/mkdirs! (str (media/cache-dir) "/outgoing"))
573+ (if-not (vidya/clipboard-image-png! path)
574+ (reset! error "No picture on the clipboard.")
575+ (let [did (:did @session)
576+ host-name @form-host
577+ channel @current]
578+ (reset! error nil)
579+ (clear-attachment!)
580+ (reset! attachment {:path path :status :uploading})
581+ (future
582+ (try
583+ (let [url (upload/upload! host-name did channel path "paste.png")]
584+ ;; Only if this is still the paste on screen: a reader who
585+ ;; pasted again, or cleared it, has said what they want, and an
586+ ;; upload landing afterwards does not get to undo that.
587+ (swap! attachment #(if (= (:path %) path)
588+ (assoc % :url url :status :ready)
589+ %))
590+ (when-not (= (:path @attachment) path) (discard-file! path)))
591+ (catch Exception e
592+ (swap! attachment #(if (= (:path %) path) nil %))
593+ (discard-file! path)
594+ (reset! error (or (ex-message e) (str e))))))))))
595+
596+(defn send-draft!
597+ "Send the draft, with whatever picture is attached to it.
598+
599+ The picture becomes its link, at the end of the line: what goes on the wire
600+ is the text the reader wrote and a URL after it, which is what every other
601+ client in the channel knows how to show. A line that is only a picture is
602+ only the link.
603+
604+ A picture still on its way up holds the send rather than losing it: the line
605+ is left in the box, said so, and the reader presses send again a moment
606+ later. Sending the text without its picture would be the one outcome nobody
607+ asked for."
608+ []
516 (let [text (str/trim @draft)609 (let [text (str/trim @draft)
517 target @current610 target @current
518- reply-to @replying-to]611+ reply-to @replying-to
519- (when (and (seq text) target)612+ {:keys [url status path] :as att} @attachment]
520- ;; Saying something is a way of asking to see it.613+ (cond
521- (jump-to-present!)614+ (not target) nil
522- (when-let [c @conn] (irc/privmsg! c target text (:id reply-to)))615+ (= :uploading status) (reset! error "The picture is still uploading.")
523- ;; The local echo carries the same link, so the chip is there before the616+ (and (str/blank? text) (not url)) nil
524- ;; server's copy of the line comes back — if it ever does.617+ :else
525- (push-message! target @form-nick text {:reply-to (:id reply-to)})618+ (let [line (str/trim (str text (when url (str " " url))))]
526- (reset! replying-to nil)619+ ;; Saying something is a way of asking to see it.
527- (reset! draft ""))))620+ (jump-to-present!)
621+ (when-let [c @conn] (irc/privmsg! c target line (:id reply-to)))
622+ ;; The local echo carries the same link, so the chip is there before
623+ ;; the server's copy of the line comes back — if it ever does.
624+ (push-message! target @form-nick line {:reply-to (:id reply-to)})
625+ (reset! replying-to nil)
626+ (reset! draft "")
627+ (when att
628+ (reset! attachment nil)
629+ ;; The picture on screen from here on is the one fetched back from
630+ ;; the link, like everyone else's.
631+ (discard-file! path))))))
632+
528 633
529 (defn open-picker!634 (defn open-picker!
530 "Choose an emoji for this message. Opening it fresh — no leftover search from635 "Choose an emoji for this message. Opening it fresh — no leftover search from
added src/frq/upload.jolt +119 -0
new file mode 100644
@@ -0,0 +1,119 @@
1+(ns frq.upload
2+ "Sending a picture: freeq's media endpoint, over the same hand-rolled TLS the
3+ rest of the client speaks.
4+
5+ IRC carries text, so a picture is shared the way every other client shares
6+ one — it is uploaded, and the link goes in the line. freeq's
7+ `POST /api/v1/upload` takes a multipart form and answers with a URL under
8+ `/api/v1/media/…`, signed and served back to anyone the link reaches.
9+
10+ The upload is authorised by the connection itself: the endpoint accepts a DID
11+ that has a live session on the server, which a signed-in client already has.
12+ A guest has no DID and cannot upload — the same line TLS draws everywhere
13+ else in this client.
14+
15+ Nothing here is streamed: an image is at most a few megabytes and the body is
16+ built in memory, which is what keeps the request one write."
17+ (:require [clojure.string :as str]
18+ [jolt.mvn-http :as tls]))
19+
20+;; The endpoint's own cap. Refusing here rather than at the server saves a
21+;; multi-megabyte upload that was always going to be rejected.
22+(def max-bytes (* 10 1024 1024))
23+
24+(defn- file-bytes [path]
25+ (let [in (java.io.FileInputStream. path)]
26+ (try (.readAllBytes in)
27+ (finally (try (.close in) (catch Exception _ nil))))))
28+
29+(defn- bytes-of [s] (.getBytes (str s)))
30+
31+(defn- boundary
32+ "A delimiter of the form the RFC allows, and one no part of this body has in
33+ it: every byte of it is a hyphen, a letter or a digit, and the parts are a
34+ PNG and a DID."
35+ [size]
36+ (str "----frq" (Math/abs (hash (str size "-frq")))))
37+
38+(defn- multipart
39+ "The request body for `fields` (strings) plus the file part, as bytes."
40+ [bound fields filename content-type file]
41+ (let [out (java.io.ByteArrayOutputStream.)
42+ dash (str "--" bound)]
43+ (doseq [[k v] fields]
44+ (.write out (bytes-of (str dash "\r\n"
45+ "Content-Disposition: form-data; name=\"" k "\"\r\n\r\n"
46+ v "\r\n"))))
47+ (.write out (bytes-of (str dash "\r\n"
48+ "Content-Disposition: form-data; name=\"file\";"
49+ " filename=\"" filename "\"\r\n"
50+ "Content-Type: " content-type "\r\n\r\n")))
51+ (.write out file)
52+ (.write out (bytes-of (str "\r\n" dash "--\r\n")))
53+ (.toByteArray out)))
54+
55+(defn- read-all!
56+ "Drain a TLS connection into a string. The response is a short JSON body, so
57+ it is read whole rather than by Content-Length."
58+ [t]
59+ (loop [acc ""]
60+ (let [b (try (tls/tls-read t) (catch Exception _ nil))]
61+ (if (or (nil? b) (zero? (count b)))
62+ acc
63+ (recur (str acc (String. b)))))))
64+
65+(defn- status-of [resp]
66+ (some-> (re-find #"^HTTP/1\.[01] (\d{3})" (or resp "")) second))
67+
68+(defn- error-message
69+ "What to show for a response that was not a 2xx. The endpoint answers JSON
70+ with a `message` or an `error` for the cases a user can do something about —
71+ not signed in, file too large — and plain text for the rest."
72+ [status body]
73+ (let [field (fn [k] (second (re-find (re-pattern (str "\"" k "\"\\s*:\\s*\"([^\"]*)\"")) (or body ""))))
74+ detail (or (field "message") (field "error") (str/trim (str body)))]
75+ (str "Upload failed (" status ")"
76+ (when (seq detail) (str ": " (subs detail 0 (min 200 (count detail))))))))
77+
78+(defn upload!
79+ "Upload `path` as `did`'s, returning the URL freeq serves it back at.
80+
81+ `channel` is passed along when there is one: the server files an upload under
82+ the conversation it was meant for. Nothing is shared to the PDS or posted to
83+ Bluesky — those are opt-in fields this client does not send.
84+
85+ Throws with a message meant to be shown when the upload is refused."
86+ [host did channel path filename]
87+ (when (str/blank? (str did))
88+ (throw (ex-info "Sign in to send a picture — an upload is filed under your account." {})))
89+ (let [file (file-bytes path)]
90+ (when (> (alength file) max-bytes)
91+ (throw (ex-info "That picture is over the 10MB the server takes." {:bytes (alength file)})))
92+ (tls/ensure-native!)
93+ (let [bound (boundary (alength file))
94+ body (multipart bound
95+ (cond-> [["did" did]]
96+ (seq (str channel)) (conj ["channel" channel]))
97+ filename "image/png" file)
98+ head (bytes-of (str "POST /api/v1/upload HTTP/1.1\r\n"
99+ "Host: " host "\r\n"
100+ "User-Agent: frq\r\n"
101+ "Accept: application/json\r\n"
102+ "Content-Type: multipart/form-data; boundary=" bound "\r\n"
103+ "Content-Length: " (alength body) "\r\n"
104+ "Connection: close\r\n\r\n"))
105+ t (tls/tls-connect host 443)]
106+ (try
107+ ;; Head and body in one write: the server reads a request, not two.
108+ (let [req (java.io.ByteArrayOutputStream.)]
109+ (.write req head)
110+ (.write req body)
111+ (tls/tls-write t (.toByteArray req)))
112+ (let [resp (read-all! t)
113+ status (status-of resp)
114+ [_ payload] (str/split resp #"\r\n\r\n" 2)]
115+ (if (and status (str/starts-with? status "2"))
116+ (or (second (re-find #"\"url\"\s*:\s*\"([^\"]*)\"" (or payload "")))
117+ (throw (ex-info "The server took the picture but named no URL for it." {})))
118+ (throw (ex-info (error-message (or status "no response") payload) {}))))
119+ (finally (try (tls/tls-close t) (catch Exception _ nil)))))))
new file mode 100644
@@ -0,0 +1,119 @@
1+(ns frq.upload
2+ "Sending a picture: freeq's media endpoint, over the same hand-rolled TLS the
3+ rest of the client speaks.
4+
5+ IRC carries text, so a picture is shared the way every other client shares
6+ one — it is uploaded, and the link goes in the line. freeq's
7+ `POST /api/v1/upload` takes a multipart form and answers with a URL under
8+ `/api/v1/media/…`, signed and served back to anyone the link reaches.
9+
10+ The upload is authorised by the connection itself: the endpoint accepts a DID
11+ that has a live session on the server, which a signed-in client already has.
12+ A guest has no DID and cannot upload — the same line TLS draws everywhere
13+ else in this client.
14+
15+ Nothing here is streamed: an image is at most a few megabytes and the body is
16+ built in memory, which is what keeps the request one write."
17+ (:require [clojure.string :as str]
18+ [jolt.mvn-http :as tls]))
19+
20+;; The endpoint's own cap. Refusing here rather than at the server saves a
21+;; multi-megabyte upload that was always going to be rejected.
22+(def max-bytes (* 10 1024 1024))
23+
24+(defn- file-bytes [path]
25+ (let [in (java.io.FileInputStream. path)]
26+ (try (.readAllBytes in)
27+ (finally (try (.close in) (catch Exception _ nil))))))
28+
29+(defn- bytes-of [s] (.getBytes (str s)))
30+
31+(defn- boundary
32+ "A delimiter of the form the RFC allows, and one no part of this body has in
33+ it: every byte of it is a hyphen, a letter or a digit, and the parts are a
34+ PNG and a DID."
35+ [size]
36+ (str "----frq" (Math/abs (hash (str size "-frq")))))
37+
38+(defn- multipart
39+ "The request body for `fields` (strings) plus the file part, as bytes."
40+ [bound fields filename content-type file]
41+ (let [out (java.io.ByteArrayOutputStream.)
42+ dash (str "--" bound)]
43+ (doseq [[k v] fields]
44+ (.write out (bytes-of (str dash "\r\n"
45+ "Content-Disposition: form-data; name=\"" k "\"\r\n\r\n"
46+ v "\r\n"))))
47+ (.write out (bytes-of (str dash "\r\n"
48+ "Content-Disposition: form-data; name=\"file\";"
49+ " filename=\"" filename "\"\r\n"
50+ "Content-Type: " content-type "\r\n\r\n")))
51+ (.write out file)
52+ (.write out (bytes-of (str "\r\n" dash "--\r\n")))
53+ (.toByteArray out)))
54+
55+(defn- read-all!
56+ "Drain a TLS connection into a string. The response is a short JSON body, so
57+ it is read whole rather than by Content-Length."
58+ [t]
59+ (loop [acc ""]
60+ (let [b (try (tls/tls-read t) (catch Exception _ nil))]
61+ (if (or (nil? b) (zero? (count b)))
62+ acc
63+ (recur (str acc (String. b)))))))
64+
65+(defn- status-of [resp]
66+ (some-> (re-find #"^HTTP/1\.[01] (\d{3})" (or resp "")) second))
67+
68+(defn- error-message
69+ "What to show for a response that was not a 2xx. The endpoint answers JSON
70+ with a `message` or an `error` for the cases a user can do something about —
71+ not signed in, file too large — and plain text for the rest."
72+ [status body]
73+ (let [field (fn [k] (second (re-find (re-pattern (str "\"" k "\"\\s*:\\s*\"([^\"]*)\"")) (or body ""))))
74+ detail (or (field "message") (field "error") (str/trim (str body)))]
75+ (str "Upload failed (" status ")"
76+ (when (seq detail) (str ": " (subs detail 0 (min 200 (count detail))))))))
77+
78+(defn upload!
79+ "Upload `path` as `did`'s, returning the URL freeq serves it back at.
80+
81+ `channel` is passed along when there is one: the server files an upload under
82+ the conversation it was meant for. Nothing is shared to the PDS or posted to
83+ Bluesky — those are opt-in fields this client does not send.
84+
85+ Throws with a message meant to be shown when the upload is refused."
86+ [host did channel path filename]
87+ (when (str/blank? (str did))
88+ (throw (ex-info "Sign in to send a picture — an upload is filed under your account." {})))
89+ (let [file (file-bytes path)]
90+ (when (> (alength file) max-bytes)
91+ (throw (ex-info "That picture is over the 10MB the server takes." {:bytes (alength file)})))
92+ (tls/ensure-native!)
93+ (let [bound (boundary (alength file))
94+ body (multipart bound
95+ (cond-> [["did" did]]
96+ (seq (str channel)) (conj ["channel" channel]))
97+ filename "image/png" file)
98+ head (bytes-of (str "POST /api/v1/upload HTTP/1.1\r\n"
99+ "Host: " host "\r\n"
100+ "User-Agent: frq\r\n"
101+ "Accept: application/json\r\n"
102+ "Content-Type: multipart/form-data; boundary=" bound "\r\n"
103+ "Content-Length: " (alength body) "\r\n"
104+ "Connection: close\r\n\r\n"))
105+ t (tls/tls-connect host 443)]
106+ (try
107+ ;; Head and body in one write: the server reads a request, not two.
108+ (let [req (java.io.ByteArrayOutputStream.)]
109+ (.write req head)
110+ (.write req body)
111+ (tls/tls-write t (.toByteArray req)))
112+ (let [resp (read-all! t)
113+ status (status-of resp)
114+ [_ payload] (str/split resp #"\r\n\r\n" 2)]
115+ (if (and status (str/starts-with? status "2"))
116+ (or (second (re-find #"\"url\"\s*:\s*\"([^\"]*)\"" (or payload "")))
117+ (throw (ex-info "The server took the picture but named no URL for it." {})))
118+ (throw (ex-info (error-message (or status "no response") payload) {}))))
119+ (finally (try (tls/tls-close t) (catch Exception _ nil)))))))