rickub
Sign in Get started
nandi/frqpublic⑂ Fork 0
⑂ f735240
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.

Resolve an identity from the phone, over the shared AT Protocol core

handle → DID → PDS, on Android, which needed HTTPS that jolt could not have
there. `HttpClient` does in four lines what frq.atproto hand-rolls onto a TLS
socket, because mvn-http's `fetch` writes to a file and cannot POST.

The flow is shared as pairs rather than whole. One platform blocks on a
socket and the other waits on a Future, and no single function is both — so
`common/frq/atproto/core.cljc` says what to ask (`resolve-handle-req`) and
what the answer means (`resolve-handle-parse`), and each side supplies only
the middle. frq.atproto puts them back together into the same three functions
its twenty-nine callers always had.

Two pieces of Java were hiding in code that looked portable, which is the
pattern of this whole port:

`Integer/parseInt` in the JSON unescaper, for a \uXXXX escape. Four digits of
hex is a fold over a lookup.

`.getBytes` and `String.` in the base64url codec. Those are genuinely the
host's job, so `frq.io` grows utf8-bytes and utf8-string. The Dart side
builds a real List<int> with `(.filled List n 0)` rather than handing over a
PersistentVector — Dart's utf8.decode wants the type, and a generic lost
through a dynamic call only fails at runtime, the same shape as the
CastStream in frq.net.dart.

frq.oauth's pure half moves too: the login URL, the handoff payload, the
session refresh as a pair. Its url-encode had a bug worth naming — it asked
`Character/isLetterOrDigit` about UTF-8 *bytes* reinterpreted as chars, and
that says yes to à and ©, so café.example went out unencoded. The unreserved
set by byte value says caf%C3%A9.example.

What oauth does not have is an Android capture. The desktop binds a loopback
socket and serves a page the browser redirects to; an Android app cannot
listen on localhost for a browser it does not own. That needs an app link or
a custom scheme and a redirect URI freeq's broker accepts, which is a
decision rather than a port.

Verified: base64url round-trips including unicode on the desktop, url-encode
matches byte for byte, the TUI renders unchanged, and the phone resolves
did:plc:padwfc6z5dke5g7c3nzratdy to its PDS.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
nandi committed 2026-09-11T18:38:40-07:00 Browse files
f735240 parent: e80514e
added common/frq/atproto/core.cljc +215 -0
new file mode 100644
@@ -0,0 +1,215 @@
1+(ns frq.atproto.core
2+ "The AT Protocol half of logging in: handle → DID → PDS → session token.
3+
4+ freeq's SASL mechanism takes a PDS access token and verifies it against the
5+ DID document itself (`method: \"pds-session\"`), so this is all the identity
6+ work the client has to do — no OAuth broker, no key material.
7+
8+ Shared, and the HTTP is not. The desktop's `request` is a blocking write and
9+ a read on a TLS socket; the phone's is a Future. Neither shape can be written
10+ once, so what lives here is everything either side of the wire: the JSON, the
11+ base64url, the SASL payloads, and — for each step of the flow — a pure
12+ function that says what to ask for and a pure function that reads the answer.
13+
14+ So `resolve-handle` is `resolve-handle-req` and `resolve-handle-parse`, and
15+ the platform supplies only the middle. `frq.atproto` on the desktop puts
16+ them back together into the same three functions its callers always had, and
17+ re-exports everything here under its own name — the same arrangement
18+ `frq.irc` and `frq.irc.parse` are in."
19+ (:require [clojure.string :as str]
20+ [frq.io :as io]))
21+
22+(def directory-host "public.api.bsky.app")
23+(def plc-host "plc.directory")
24+
25+;; ------------------------------------------------------------------ JSON
26+
27+(defn json-str
28+ "The string value of a top-level JSON field, or nil.
29+
30+ Enough of a parser for the four fields this namespace reads. Escapes are
31+ passed through unchanged — none of a DID, a handle, a URL or a JWT contains
32+ one."
33+ [json field]
34+ (let [m (re-find (re-pattern (str "\"" field "\"\\s*:\\s*\"([^\"]*)\"")) (or json ""))]
35+ (second m)))
36+
37+(defn json-num
38+ "The numeric value of a top-level JSON field, or nil.
39+
40+ Written out as a string rather than parsed into a number: the counts on a
41+ profile are only ever printed, and \"1204\" is what printing them wants."
42+ [json field]
43+ (second (re-find (re-pattern (str "\"" field "\"\\s*:\\s*(-?[0-9]+)")) (or json ""))))
44+
45+(def ^:private hex-digits
46+ ;; A lookup rather than a radix parse. `Integer/parseInt` is Java and there
47+ ;; is none of it under ClojureDart; four digits of hex is a fold.
48+ (into {} (map-indexed (fn [i c] [c i]) "0123456789abcdef")))
49+
50+(defn- hex->int [s]
51+ (reduce (fn [acc c] (+ (* 16 acc) (get hex-digits (first (str/lower-case (str c))) 0)))
52+ 0
53+ (seq s)))
54+
55+(defn json-unescape
56+ "A JSON string body back to the text it stands for.
57+
58+ `json-str` hands back the escapes as they were written, which is right for a
59+ DID or a URL — none of them contains one — and wrong for a bio, where the
60+ line breaks someone typed arrive as backslash-n. Only the escapes a bio can
61+ carry are undone; a stray backslash is left alone rather than eaten."
62+ [s]
63+ (str/replace (or s "") #"\\(u[0-9a-fA-F]{4}|.)"
64+ (fn [[whole esc]]
65+ (case (first esc)
66+ \n "\n"
67+ \t "\t"
68+ \r "\r"
69+ \b "\b"
70+ \f "\f"
71+ \" "\""
72+ \\ "\\"
73+ \/ "/"
74+ \u (str (char (hex->int (subs esc 1))))
75+ whole))))
76+
77+(defn- json-escape [s]
78+ (-> (or s "")
79+ (str/replace "\\" "\\\\")
80+ (str/replace "\"" "\\\"")))
81+
82+(defn json-object
83+ "A flat JSON object from a map of string keys to string values."
84+ [m]
85+ (str "{" (str/join "," (for [[k v] m] (str "\"" k "\":\"" (json-escape v) "\""))) "}"))
86+
87+;; ------------------------------------------------------------------ identity
88+
89+
90+;; ------------------------------------------------------------------ identity
91+;;
92+;; Each step is a pair: a `-req` that describes the call and a `-parse` that
93+;; reads the body. Both are pure, so the flow is testable without a socket and
94+;; is the same on both platforms — only who performs the request differs.
95+
96+(defn resolve-handle-req
97+ "What to ask to turn a handle into a DID, or nil when it is already one and
98+ there is nothing to ask."
99+ [handle]
100+ (let [h (str/trim (or handle ""))]
101+ (when-not (str/starts-with? h "did:")
102+ {:host directory-host
103+ :path (str "/xrpc/com.atproto.identity.resolveHandle?handle=" h)})))
104+
105+(defn resolve-handle-parse
106+ "The DID out of that answer. A handle that is already a DID needs no call and
107+ passes through, which is why `body` may be nil."
108+ [handle body]
109+ (let [h (str/trim (or handle ""))]
110+ (if (str/starts-with? h "did:")
111+ h
112+ (or (json-str body "did")
113+ (throw (ex-info (str "Could not resolve handle " h) {:handle h :body body}))))))
114+
115+(defn pds-doc-req
116+ "Where the DID document lives. did:plc documents come from the PLC
117+ directory; did:web ones from the domain itself, which is the whole of what
118+ did:web means."
119+ [did]
120+ (cond
121+ (str/starts-with? did "did:plc:") {:host plc-host :path (str "/" did)}
122+ (str/starts-with? did "did:web:") {:host (subs did (count "did:web:"))
123+ :path "/.well-known/did.json"}
124+ :else (throw (ex-info (str "Unsupported DID method: " did) {:did did}))))
125+
126+(defn pds-endpoint-parse
127+ "The PDS service endpoint out of a DID document.
128+
129+ The document lists several services; the PDS is the one whose entry carries a
130+ serviceEndpoint next to type AtprotoPersonalDataServer."
131+ [did doc]
132+ (or (second (re-find #"\"AtprotoPersonalDataServer\"\s*,\s*\"serviceEndpoint\"\s*:\s*\"([^\"]*)\"" doc))
133+ (second (re-find #"\"serviceEndpoint\"\s*:\s*\"([^\"]*)\"[^}]*\"AtprotoPersonalDataServer\"" doc))
134+ (json-str doc "serviceEndpoint")
135+ (throw (ex-info (str "No PDS endpoint for " did) {:did did}))))
136+
137+(defn host-of [url]
138+ (-> url (str/replace #"^https?://" "") (str/split #"/") first))
139+
140+(defn create-session-req
141+ "Sign in to the PDS with an app password.
142+
143+ The password goes to the user's own PDS and nowhere else — freeq never sees
144+ it, and verifies the token it gets by asking that same PDS."
145+ [pds identifier password]
146+ {:host (host-of pds)
147+ :path "/xrpc/com.atproto.server.createSession"
148+ :body (json-object {"identifier" identifier "password" password})})
149+
150+(defn create-session-parse
151+ "{:did :handle :access-jwt :pds} out of that answer."
152+ [identifier did pds body]
153+ (let [jwt (json-str body "accessJwt")]
154+ (when-not jwt
155+ (throw (ex-info (or (json-str body "message") "Sign-in failed") {:body body})))
156+ {:did (or (json-str body "did") did)
157+ :handle (or (json-str body "handle") identifier)
158+ :access-jwt jwt
159+ :pds pds}))
160+
161+
162+;; ------------------------------------------------------------------ base64url
163+
164+(def ^:private alphabet
165+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
166+
167+(defn b64-encode
168+ "base64url of a string, unpadded — what SASL and freeq's challenge use.
169+ Hand-rolled rather than java.util.Base64: the host classes jolt registers are
170+ not all there in a cross-compiled boot image, there is no java.util at all
171+ under ClojureDart, and this is three lines. The bytes come from `frq.io`,
172+ which is the one part of it that differs."
173+ [s]
174+ (let [bs (vec (io/utf8-bytes s))]
175+ (apply str
176+ (for [group (partition-all 3 bs)
177+ :let [[a b c] group
178+ n (count group)
179+ v (+ (bit-shift-left a 16)
180+ (bit-shift-left (or b 0) 8)
181+ (or c 0))]
182+ i (range (inc n))]
183+ (nth alphabet (bit-and (bit-shift-right v (* 6 (- 3 i))) 0x3f))))))
184+
185+(defn b64-decode
186+ "base64url back to a string. Padding is tolerated and ignored."
187+ [s]
188+ (let [idx (into {} (map-indexed (fn [i c] [c i]) alphabet))
189+ vals (keep idx (remove #{\=} (seq (or s ""))))
190+ bytes (for [group (partition-all 4 vals)
191+ :let [n (count group)
192+ v (reduce (fn [acc x] (+ (bit-shift-left acc 6) x))
193+ 0
194+ (concat group (repeat (- 4 n) 0)))]
195+ i (range (dec n))]
196+ (bit-and (bit-shift-right v (* 8 (- 2 i))) 0xff))]
197+ (io/utf8-string bytes)))
198+
199+(defn sasl-response
200+ "The base64url SASL payload for a session, either kind freeq takes.
201+
202+ A `:pds-session` carries the PDS token, the DID it belongs to, its PDS, and
203+ the server's own nonce echoed back so the token cannot be replayed at another
204+ server. A `:web-token` from the auth broker carries only the token — the
205+ server looks the DID up in its own token store, which is why the field is
206+ sent empty rather than guessed at."
207+ [session nonce]
208+ (b64-encode
209+ (if (= :web-token (:kind session))
210+ (json-object {"did" "" "method" "web-token" "signature" (:token session)})
211+ (json-object {"did" (:did session)
212+ "signature" (:access-jwt session)
213+ "method" "pds-session"
214+ "pds_url" (:pds session)
215+ "challenge_nonce" nonce}))))
new file mode 100644
@@ -0,0 +1,215 @@
1+(ns frq.atproto.core
2+ "The AT Protocol half of logging in: handle → DID → PDS → session token.
3+
4+ freeq's SASL mechanism takes a PDS access token and verifies it against the
5+ DID document itself (`method: \"pds-session\"`), so this is all the identity
6+ work the client has to do — no OAuth broker, no key material.
7+
8+ Shared, and the HTTP is not. The desktop's `request` is a blocking write and
9+ a read on a TLS socket; the phone's is a Future. Neither shape can be written
10+ once, so what lives here is everything either side of the wire: the JSON, the
11+ base64url, the SASL payloads, and — for each step of the flow — a pure
12+ function that says what to ask for and a pure function that reads the answer.
13+
14+ So `resolve-handle` is `resolve-handle-req` and `resolve-handle-parse`, and
15+ the platform supplies only the middle. `frq.atproto` on the desktop puts
16+ them back together into the same three functions its callers always had, and
17+ re-exports everything here under its own name — the same arrangement
18+ `frq.irc` and `frq.irc.parse` are in."
19+ (:require [clojure.string :as str]
20+ [frq.io :as io]))
21+
22+(def directory-host "public.api.bsky.app")
23+(def plc-host "plc.directory")
24+
25+;; ------------------------------------------------------------------ JSON
26+
27+(defn json-str
28+ "The string value of a top-level JSON field, or nil.
29+
30+ Enough of a parser for the four fields this namespace reads. Escapes are
31+ passed through unchanged — none of a DID, a handle, a URL or a JWT contains
32+ one."
33+ [json field]
34+ (let [m (re-find (re-pattern (str "\"" field "\"\\s*:\\s*\"([^\"]*)\"")) (or json ""))]
35+ (second m)))
36+
37+(defn json-num
38+ "The numeric value of a top-level JSON field, or nil.
39+
40+ Written out as a string rather than parsed into a number: the counts on a
41+ profile are only ever printed, and \"1204\" is what printing them wants."
42+ [json field]
43+ (second (re-find (re-pattern (str "\"" field "\"\\s*:\\s*(-?[0-9]+)")) (or json ""))))
44+
45+(def ^:private hex-digits
46+ ;; A lookup rather than a radix parse. `Integer/parseInt` is Java and there
47+ ;; is none of it under ClojureDart; four digits of hex is a fold.
48+ (into {} (map-indexed (fn [i c] [c i]) "0123456789abcdef")))
49+
50+(defn- hex->int [s]
51+ (reduce (fn [acc c] (+ (* 16 acc) (get hex-digits (first (str/lower-case (str c))) 0)))
52+ 0
53+ (seq s)))
54+
55+(defn json-unescape
56+ "A JSON string body back to the text it stands for.
57+
58+ `json-str` hands back the escapes as they were written, which is right for a
59+ DID or a URL — none of them contains one — and wrong for a bio, where the
60+ line breaks someone typed arrive as backslash-n. Only the escapes a bio can
61+ carry are undone; a stray backslash is left alone rather than eaten."
62+ [s]
63+ (str/replace (or s "") #"\\(u[0-9a-fA-F]{4}|.)"
64+ (fn [[whole esc]]
65+ (case (first esc)
66+ \n "\n"
67+ \t "\t"
68+ \r "\r"
69+ \b "\b"
70+ \f "\f"
71+ \" "\""
72+ \\ "\\"
73+ \/ "/"
74+ \u (str (char (hex->int (subs esc 1))))
75+ whole))))
76+
77+(defn- json-escape [s]
78+ (-> (or s "")
79+ (str/replace "\\" "\\\\")
80+ (str/replace "\"" "\\\"")))
81+
82+(defn json-object
83+ "A flat JSON object from a map of string keys to string values."
84+ [m]
85+ (str "{" (str/join "," (for [[k v] m] (str "\"" k "\":\"" (json-escape v) "\""))) "}"))
86+
87+;; ------------------------------------------------------------------ identity
88+
89+
90+;; ------------------------------------------------------------------ identity
91+;;
92+;; Each step is a pair: a `-req` that describes the call and a `-parse` that
93+;; reads the body. Both are pure, so the flow is testable without a socket and
94+;; is the same on both platforms — only who performs the request differs.
95+
96+(defn resolve-handle-req
97+ "What to ask to turn a handle into a DID, or nil when it is already one and
98+ there is nothing to ask."
99+ [handle]
100+ (let [h (str/trim (or handle ""))]
101+ (when-not (str/starts-with? h "did:")
102+ {:host directory-host
103+ :path (str "/xrpc/com.atproto.identity.resolveHandle?handle=" h)})))
104+
105+(defn resolve-handle-parse
106+ "The DID out of that answer. A handle that is already a DID needs no call and
107+ passes through, which is why `body` may be nil."
108+ [handle body]
109+ (let [h (str/trim (or handle ""))]
110+ (if (str/starts-with? h "did:")
111+ h
112+ (or (json-str body "did")
113+ (throw (ex-info (str "Could not resolve handle " h) {:handle h :body body}))))))
114+
115+(defn pds-doc-req
116+ "Where the DID document lives. did:plc documents come from the PLC
117+ directory; did:web ones from the domain itself, which is the whole of what
118+ did:web means."
119+ [did]
120+ (cond
121+ (str/starts-with? did "did:plc:") {:host plc-host :path (str "/" did)}
122+ (str/starts-with? did "did:web:") {:host (subs did (count "did:web:"))
123+ :path "/.well-known/did.json"}
124+ :else (throw (ex-info (str "Unsupported DID method: " did) {:did did}))))
125+
126+(defn pds-endpoint-parse
127+ "The PDS service endpoint out of a DID document.
128+
129+ The document lists several services; the PDS is the one whose entry carries a
130+ serviceEndpoint next to type AtprotoPersonalDataServer."
131+ [did doc]
132+ (or (second (re-find #"\"AtprotoPersonalDataServer\"\s*,\s*\"serviceEndpoint\"\s*:\s*\"([^\"]*)\"" doc))
133+ (second (re-find #"\"serviceEndpoint\"\s*:\s*\"([^\"]*)\"[^}]*\"AtprotoPersonalDataServer\"" doc))
134+ (json-str doc "serviceEndpoint")
135+ (throw (ex-info (str "No PDS endpoint for " did) {:did did}))))
136+
137+(defn host-of [url]
138+ (-> url (str/replace #"^https?://" "") (str/split #"/") first))
139+
140+(defn create-session-req
141+ "Sign in to the PDS with an app password.
142+
143+ The password goes to the user's own PDS and nowhere else — freeq never sees
144+ it, and verifies the token it gets by asking that same PDS."
145+ [pds identifier password]
146+ {:host (host-of pds)
147+ :path "/xrpc/com.atproto.server.createSession"
148+ :body (json-object {"identifier" identifier "password" password})})
149+
150+(defn create-session-parse
151+ "{:did :handle :access-jwt :pds} out of that answer."
152+ [identifier did pds body]
153+ (let [jwt (json-str body "accessJwt")]
154+ (when-not jwt
155+ (throw (ex-info (or (json-str body "message") "Sign-in failed") {:body body})))
156+ {:did (or (json-str body "did") did)
157+ :handle (or (json-str body "handle") identifier)
158+ :access-jwt jwt
159+ :pds pds}))
160+
161+
162+;; ------------------------------------------------------------------ base64url
163+
164+(def ^:private alphabet
165+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
166+
167+(defn b64-encode
168+ "base64url of a string, unpadded — what SASL and freeq's challenge use.
169+ Hand-rolled rather than java.util.Base64: the host classes jolt registers are
170+ not all there in a cross-compiled boot image, there is no java.util at all
171+ under ClojureDart, and this is three lines. The bytes come from `frq.io`,
172+ which is the one part of it that differs."
173+ [s]
174+ (let [bs (vec (io/utf8-bytes s))]
175+ (apply str
176+ (for [group (partition-all 3 bs)
177+ :let [[a b c] group
178+ n (count group)
179+ v (+ (bit-shift-left a 16)
180+ (bit-shift-left (or b 0) 8)
181+ (or c 0))]
182+ i (range (inc n))]
183+ (nth alphabet (bit-and (bit-shift-right v (* 6 (- 3 i))) 0x3f))))))
184+
185+(defn b64-decode
186+ "base64url back to a string. Padding is tolerated and ignored."
187+ [s]
188+ (let [idx (into {} (map-indexed (fn [i c] [c i]) alphabet))
189+ vals (keep idx (remove #{\=} (seq (or s ""))))
190+ bytes (for [group (partition-all 4 vals)
191+ :let [n (count group)
192+ v (reduce (fn [acc x] (+ (bit-shift-left acc 6) x))
193+ 0
194+ (concat group (repeat (- 4 n) 0)))]
195+ i (range (dec n))]
196+ (bit-and (bit-shift-right v (* 8 (- 2 i))) 0xff))]
197+ (io/utf8-string bytes)))
198+
199+(defn sasl-response
200+ "The base64url SASL payload for a session, either kind freeq takes.
201+
202+ A `:pds-session` carries the PDS token, the DID it belongs to, its PDS, and
203+ the server's own nonce echoed back so the token cannot be replayed at another
204+ server. A `:web-token` from the auth broker carries only the token — the
205+ server looks the DID up in its own token store, which is why the field is
206+ sent empty rather than guessed at."
207+ [session nonce]
208+ (b64-encode
209+ (if (= :web-token (:kind session))
210+ (json-object {"did" "" "method" "web-token" "signature" (:token session)})
211+ (json-object {"did" (:did session)
212+ "signature" (:access-jwt session)
213+ "method" "pds-session"
214+ "pds_url" (:pds session)
215+ "challenge_nonce" nonce}))))
modified common/frq/io.cljc +17 -0
@@ -85,6 +85,23 @@
8585 [path s]
8686 (call :write-private-file! [path s]))
8787
88+;; -------------------------------------------------------------------- text
89+
90+(defn utf8-bytes
91+ "A string as a sequence of byte values, 0-255.
92+
93+ In the seam because there is no portable way to say it: jolt has
94+ `.getBytes`, which is Java, and ClojureDart has `dart:convert`. `frq.atproto`
95+ needs it for base64url — SASL is bytes, and a handle with a non-ASCII
96+ character in it encodes to more of them than it has characters."
97+ [s]
98+ (call :utf8-bytes [s]))
99+
100+(defn utf8-string
101+ "The inverse: byte values back to the text they spell."
102+ [bytes]
103+ (call :utf8-string [bytes]))
104+
88105 ;; ------------------------------------------------------------------- time
89106
90107 (defn wall-nanos [] (call :wall-nanos []))
@@ -85,6 +85,23 @@
85 [path s]85 [path s]
86 (call :write-private-file! [path s]))86 (call :write-private-file! [path s]))
87 87
88+;; -------------------------------------------------------------------- text
89+
90+(defn utf8-bytes
91+ "A string as a sequence of byte values, 0-255.
92+
93+ In the seam because there is no portable way to say it: jolt has
94+ `.getBytes`, which is Java, and ClojureDart has `dart:convert`. `frq.atproto`
95+ needs it for base64url — SASL is bytes, and a handle with a non-ASCII
96+ character in it encodes to more of them than it has characters."
97+ [s]
98+ (call :utf8-bytes [s]))
99+
100+(defn utf8-string
101+ "The inverse: byte values back to the text they spell."
102+ [bytes]
103+ (call :utf8-string [bytes]))
104+
88 ;; ------------------------------------------------------------------- time105 ;; ------------------------------------------------------------------- time
89 106
90 (defn wall-nanos [] (call :wall-nanos []))107 (defn wall-nanos [] (call :wall-nanos []))
added common/frq/oauth/core.cljc +96 -0
new file mode 100644
@@ -0,0 +1,96 @@
1+(ns frq.oauth.core
2+ "The broker flow, minus the waiting: login URL in, handoff payload out.
3+
4+ freeq's auth broker does the AT Protocol OAuth and hands back a payload; all
5+ a client does is build the URL, open it, and read what comes back. Building
6+ and reading are the same everywhere and live here. Catching the handoff is
7+ not: the desktop listens on a loopback socket and the phone cannot — see
8+ `frq.oauth` for what that means.
9+
10+ `refresh-session` is a `-req`/`-parse` pair for the same reason
11+ `frq.atproto.core`'s steps are: one platform waits on a socket and the other
12+ on a Future, and neither shape is writable once."
13+ (:require [clojure.string :as str]
14+ [frq.atproto.core :as atproto]
15+ [frq.io :as io]))
16+
17+(def default-broker "https://auth.freeq.at")
18+
19+;; ------------------------------------------------------------------ urls
20+
21+(def ^:private hex "0123456789ABCDEF")
22+
23+(defn- unreserved?
24+ "RFC 3986's unreserved set, as byte values: A-Z a-z 0-9 - _ . ~
25+
26+ By number rather than `Character/isLetterOrDigit`, which is Java and would
27+ also say yes to é — and a percent-encoder that passes é through has not
28+ encoded anything."
29+ [b]
30+ (or (<= 48 b 57) (<= 65 b 90) (<= 97 b 122)
31+ (contains? #{45 95 46 126} b)))
32+
33+(defn url-encode
34+ "Percent-encode everything a handle could hold that a query string cannot.
35+
36+ Over UTF-8 bytes, not characters: a non-ASCII handle is several bytes and
37+ each one is encoded separately, which is what the spec says and what the
38+ broker expects."
39+ [s]
40+ (apply str
41+ (for [b (io/utf8-bytes s)]
42+ (if (unreserved? b)
43+ (char b)
44+ (str "%" (nth hex (quot b 16)) (nth hex (mod b 16)))))))
45+
46+(defn login-url [broker handle return-to]
47+ (let [base (str/replace (or broker default-broker) #"/+$" "")
48+ handle (-> (or handle "") str/trim (str/replace #"^@" ""))]
49+ (str base "/auth/login?handle=" (url-encode handle)
50+ "&return_to=" (url-encode return-to))))
51+
52+(defn broker-host [broker]
53+ (-> (or broker default-broker)
54+ (str/replace #"^https?://" "")
55+ (str/split #"/")
56+ first))
57+
58+;; ------------------------------------------------------------------ handoff
59+
60+(defn tokens-of
61+ "The broker's base64url JSON payload as {:token :broker-token :nick :did
62+ :handle}."
63+ [payload]
64+ (let [json (atproto/b64-decode (str/trim payload))
65+ token (atproto/json-str json "token")
66+ broker (atproto/json-str json "broker_token")]
67+ (when-not (and token broker)
68+ (throw (ex-info (or (atproto/json-str json "error") "Malformed sign-in payload")
69+ {:body json})))
70+ {:token token
71+ :broker-token broker
72+ :nick (atproto/json-str json "nick")
73+ :did (atproto/json-str json "did")
74+ :handle (or (atproto/json-str json "handle") "")}))
75+
76+;; ------------------------------------------------------------------ session
77+
78+(defn refresh-session-req
79+ "Mint a fresh single-use web-token from the durable broker token. This is
80+ what a reconnect uses; the token from the browser handoff is spent."
81+ [broker broker-token]
82+ {:host (broker-host broker)
83+ :path "/session"
84+ :body (atproto/json-object {"broker_token" broker-token})})
85+
86+(defn refresh-session-parse [broker-token body]
87+ (let [token (atproto/json-str body "token")]
88+ (when-not token
89+ (throw (ex-info (or (atproto/json-str body "message")
90+ "Broker session refresh failed — sign in again")
91+ {:body body})))
92+ {:token token
93+ :broker-token broker-token
94+ :nick (atproto/json-str body "nick")
95+ :did (atproto/json-str body "did")
96+ :handle (or (atproto/json-str body "handle") "")}))
new file mode 100644
@@ -0,0 +1,96 @@
1+(ns frq.oauth.core
2+ "The broker flow, minus the waiting: login URL in, handoff payload out.
3+
4+ freeq's auth broker does the AT Protocol OAuth and hands back a payload; all
5+ a client does is build the URL, open it, and read what comes back. Building
6+ and reading are the same everywhere and live here. Catching the handoff is
7+ not: the desktop listens on a loopback socket and the phone cannot — see
8+ `frq.oauth` for what that means.
9+
10+ `refresh-session` is a `-req`/`-parse` pair for the same reason
11+ `frq.atproto.core`'s steps are: one platform waits on a socket and the other
12+ on a Future, and neither shape is writable once."
13+ (:require [clojure.string :as str]
14+ [frq.atproto.core :as atproto]
15+ [frq.io :as io]))
16+
17+(def default-broker "https://auth.freeq.at")
18+
19+;; ------------------------------------------------------------------ urls
20+
21+(def ^:private hex "0123456789ABCDEF")
22+
23+(defn- unreserved?
24+ "RFC 3986's unreserved set, as byte values: A-Z a-z 0-9 - _ . ~
25+
26+ By number rather than `Character/isLetterOrDigit`, which is Java and would
27+ also say yes to é — and a percent-encoder that passes é through has not
28+ encoded anything."
29+ [b]
30+ (or (<= 48 b 57) (<= 65 b 90) (<= 97 b 122)
31+ (contains? #{45 95 46 126} b)))
32+
33+(defn url-encode
34+ "Percent-encode everything a handle could hold that a query string cannot.
35+
36+ Over UTF-8 bytes, not characters: a non-ASCII handle is several bytes and
37+ each one is encoded separately, which is what the spec says and what the
38+ broker expects."
39+ [s]
40+ (apply str
41+ (for [b (io/utf8-bytes s)]
42+ (if (unreserved? b)
43+ (char b)
44+ (str "%" (nth hex (quot b 16)) (nth hex (mod b 16)))))))
45+
46+(defn login-url [broker handle return-to]
47+ (let [base (str/replace (or broker default-broker) #"/+$" "")
48+ handle (-> (or handle "") str/trim (str/replace #"^@" ""))]
49+ (str base "/auth/login?handle=" (url-encode handle)
50+ "&return_to=" (url-encode return-to))))
51+
52+(defn broker-host [broker]
53+ (-> (or broker default-broker)
54+ (str/replace #"^https?://" "")
55+ (str/split #"/")
56+ first))
57+
58+;; ------------------------------------------------------------------ handoff
59+
60+(defn tokens-of
61+ "The broker's base64url JSON payload as {:token :broker-token :nick :did
62+ :handle}."
63+ [payload]
64+ (let [json (atproto/b64-decode (str/trim payload))
65+ token (atproto/json-str json "token")
66+ broker (atproto/json-str json "broker_token")]
67+ (when-not (and token broker)
68+ (throw (ex-info (or (atproto/json-str json "error") "Malformed sign-in payload")
69+ {:body json})))
70+ {:token token
71+ :broker-token broker
72+ :nick (atproto/json-str json "nick")
73+ :did (atproto/json-str json "did")
74+ :handle (or (atproto/json-str json "handle") "")}))
75+
76+;; ------------------------------------------------------------------ session
77+
78+(defn refresh-session-req
79+ "Mint a fresh single-use web-token from the durable broker token. This is
80+ what a reconnect uses; the token from the browser handoff is spent."
81+ [broker broker-token]
82+ {:host (broker-host broker)
83+ :path "/session"
84+ :body (atproto/json-object {"broker_token" broker-token})})
85+
86+(defn refresh-session-parse [broker-token body]
87+ (let [token (atproto/json-str body "token")]
88+ (when-not token
89+ (throw (ex-info (or (atproto/json-str body "message")
90+ "Broker session refresh failed — sign in again")
91+ {:body body})))
92+ {:token token
93+ :broker-token broker-token
94+ :nick (atproto/json-str body "nick")
95+ :did (atproto/json-str body "did")
96+ :handle (or (atproto/json-str body "handle") "")}))
modified flutter/README.md +12 -2
@@ -145,8 +145,18 @@ only tags `frq.app` uses, so it is a test of the backend and nothing more.
145145 MOTD, which is the thing the jolt APK could never do. What is left of this
146146 one is the protocol half: CAP, SASL and the idle-ping logic still live in
147147 `src/frq/irc.clj` and want `frq.msgsig` and `frq.atproto` under them first.
148-2. **`frq.atproto`** (209), **`frq.oauth`** (182) — hand-rolled HTTPS over
149- OpenSSL bindings today, `dart:io` and `package:http` here.
148+2. ~~**`frq.atproto`**~~ — done. `common/frq/atproto/core.cljc` is the JSON,
149+ the base64url, the SASL payloads, and a `-req`/`-parse` pair per step of the
150+ flow; `frq.atproto` and `frq.atproto.dart` supply the middle. **handle → DID
151+ → PDS resolves on the phone**, over `HttpClient`.
152+
153+ **`frq.oauth`** — half done. `common/frq/oauth/core.cljc` has the URL, the
154+ handoff payload and the session refresh. What has no Android answer yet is
155+ the capture: the desktop binds a loopback socket and serves a page the
156+ browser redirects to, and an Android app cannot listen on localhost for a
157+ browser it does not own. That wants an app link or a custom scheme, an
158+ intent filter, and a redirect URI the broker will accept — a decision about
159+ freeq's broker, not a porting problem.
150160 3. **`frq.msgsig`** (268), **`frq.wire`** (81) — need a crypto seam beside the
151161 io one.
152162 4. **`frq.avatars`**, **`frq.media`**, **`frq.profile`**, **`frq.platform`** —
@@ -145,8 +145,18 @@ only tags `frq.app` uses, so it is a test of the backend and nothing more.
145 MOTD, which is the thing the jolt APK could never do. What is left of this145 MOTD, which is the thing the jolt APK could never do. What is left of this
146 one is the protocol half: CAP, SASL and the idle-ping logic still live in146 one is the protocol half: CAP, SASL and the idle-ping logic still live in
147 `src/frq/irc.clj` and want `frq.msgsig` and `frq.atproto` under them first.147 `src/frq/irc.clj` and want `frq.msgsig` and `frq.atproto` under them first.
148-2. **`frq.atproto`** (209), **`frq.oauth`** (182) — hand-rolled HTTPS over148+2. ~~**`frq.atproto`**~~ — done. `common/frq/atproto/core.cljc` is the JSON,
149- OpenSSL bindings today, `dart:io` and `package:http` here.149+ the base64url, the SASL payloads, and a `-req`/`-parse` pair per step of the
150+ flow; `frq.atproto` and `frq.atproto.dart` supply the middle. **handle → DID
151+ → PDS resolves on the phone**, over `HttpClient`.
152+
153+ **`frq.oauth`** — half done. `common/frq/oauth/core.cljc` has the URL, the
154+ handoff payload and the session refresh. What has no Android answer yet is
155+ the capture: the desktop binds a loopback socket and serves a page the
156+ browser redirects to, and an Android app cannot listen on localhost for a
157+ browser it does not own. That wants an app link or a custom scheme, an
158+ intent filter, and a redirect URI the broker will accept — a decision about
159+ freeq's broker, not a porting problem.
150 3. **`frq.msgsig`** (268), **`frq.wire`** (81) — need a crypto seam beside the160 3. **`frq.msgsig`** (268), **`frq.wire`** (81) — need a crypto seam beside the
151 io one.161 io one.
152 4. **`frq.avatars`**, **`frq.media`**, **`frq.profile`**, **`frq.platform`** —162 4. **`frq.avatars`**, **`frq.media`**, **`frq.profile`**, **`frq.platform`** —
added flutter/src/frq/atproto/dart.cljd +60 -0
new file mode 100644
@@ -0,0 +1,60 @@
1+(ns frq.atproto.dart
2+ "The phone's AT Protocol: `frq.atproto.core` with dart:io under it.
3+
4+ The mirror of `frq.atproto` on the desktop, and shorter than it by the whole
5+ of the HTTP — jolt hand-rolls request lines onto a TLS socket because
6+ mvn-http's `fetch` writes to a file and cannot POST, and `HttpClient` simply
7+ does it. TLS included, which is the part Android never had.
8+
9+ Async all the way down, so these cannot be the same functions the desktop
10+ exposes even though they do the same thing. That is the reason core is split
11+ into `-req` and `-parse` pairs rather than shared whole: the descriptions and
12+ the answers are portable, and only who waits for them is not."
13+ (:require ["dart:convert" :as conv]
14+ ["dart:io" :as io]
15+ [frq.atproto.core :as core]))
16+
17+(defonce ^:private client (io/HttpClient.))
18+
19+(defn ^:async fetch
20+ "Perform one `-req` descriptor and return the body as a string.
21+
22+ `body` nil is a GET. Always https: every host core names is an AT Protocol
23+ service, and there is no plaintext variant of any of them."
24+ [{:keys [host path body]}]
25+ ;; Uri.parse of a whole URL rather than Uri.https of host and path: a
26+ ;; resolveHandle path carries its query string, and Uri.https would escape
27+ ;; the ? into the path.
28+ (let [uri (Uri.parse (str "https://" host path))
29+ req (await (if body (.postUrl client uri) (.getUrl client uri)))]
30+ (.set (.-headers req) "user-agent" "frq")
31+ (.set (.-headers req) "accept" "application/json")
32+ (when body
33+ (.set (.-headers req) "content-type" "application/json")
34+ (.write req body))
35+ (let [resp (await (.close req))]
36+ (await (.join (.transform resp (.-decoder conv/utf8)))))))
37+
38+(defn ^:async resolve-handle
39+ "A handle (alice.bsky.social) to its DID. A DID passes through untouched."
40+ [handle]
41+ (let [req (core/resolve-handle-req handle)]
42+ (core/resolve-handle-parse handle (when req (await (fetch req))))))
43+
44+(defn ^:async pds-endpoint
45+ "The DID's PDS service endpoint, from its DID document."
46+ [did]
47+ (core/pds-endpoint-parse did (await (fetch (core/pds-doc-req did)))))
48+
49+(defn ^:async create-session
50+ "Sign in to the PDS with an app password. Returns
51+ {:did :handle :access-jwt :pds}.
52+
53+ The password goes to the user's own PDS and nowhere else — freeq never sees
54+ it, and verifies the token it gets by asking that same PDS."
55+ [identifier password]
56+ (let [did (await (resolve-handle identifier))
57+ pds (await (pds-endpoint did))]
58+ (core/create-session-parse
59+ identifier did pds
60+ (await (fetch (core/create-session-req pds identifier password))))))
new file mode 100644
@@ -0,0 +1,60 @@
1+(ns frq.atproto.dart
2+ "The phone's AT Protocol: `frq.atproto.core` with dart:io under it.
3+
4+ The mirror of `frq.atproto` on the desktop, and shorter than it by the whole
5+ of the HTTP — jolt hand-rolls request lines onto a TLS socket because
6+ mvn-http's `fetch` writes to a file and cannot POST, and `HttpClient` simply
7+ does it. TLS included, which is the part Android never had.
8+
9+ Async all the way down, so these cannot be the same functions the desktop
10+ exposes even though they do the same thing. That is the reason core is split
11+ into `-req` and `-parse` pairs rather than shared whole: the descriptions and
12+ the answers are portable, and only who waits for them is not."
13+ (:require ["dart:convert" :as conv]
14+ ["dart:io" :as io]
15+ [frq.atproto.core :as core]))
16+
17+(defonce ^:private client (io/HttpClient.))
18+
19+(defn ^:async fetch
20+ "Perform one `-req` descriptor and return the body as a string.
21+
22+ `body` nil is a GET. Always https: every host core names is an AT Protocol
23+ service, and there is no plaintext variant of any of them."
24+ [{:keys [host path body]}]
25+ ;; Uri.parse of a whole URL rather than Uri.https of host and path: a
26+ ;; resolveHandle path carries its query string, and Uri.https would escape
27+ ;; the ? into the path.
28+ (let [uri (Uri.parse (str "https://" host path))
29+ req (await (if body (.postUrl client uri) (.getUrl client uri)))]
30+ (.set (.-headers req) "user-agent" "frq")
31+ (.set (.-headers req) "accept" "application/json")
32+ (when body
33+ (.set (.-headers req) "content-type" "application/json")
34+ (.write req body))
35+ (let [resp (await (.close req))]
36+ (await (.join (.transform resp (.-decoder conv/utf8)))))))
37+
38+(defn ^:async resolve-handle
39+ "A handle (alice.bsky.social) to its DID. A DID passes through untouched."
40+ [handle]
41+ (let [req (core/resolve-handle-req handle)]
42+ (core/resolve-handle-parse handle (when req (await (fetch req))))))
43+
44+(defn ^:async pds-endpoint
45+ "The DID's PDS service endpoint, from its DID document."
46+ [did]
47+ (core/pds-endpoint-parse did (await (fetch (core/pds-doc-req did)))))
48+
49+(defn ^:async create-session
50+ "Sign in to the PDS with an app password. Returns
51+ {:did :handle :access-jwt :pds}.
52+
53+ The password goes to the user's own PDS and nowhere else — freeq never sees
54+ it, and verifies the token it gets by asking that same PDS."
55+ [identifier password]
56+ (let [did (await (resolve-handle identifier))
57+ pds (await (pds-endpoint did))]
58+ (core/create-session-parse
59+ identifier did pds
60+ (await (fetch (core/create-session-req pds identifier password))))))
modified flutter/src/frq/io/dart.cljd +21 -1
@@ -15,7 +15,8 @@
1515 UNVERIFIED. Nothing in this tree compiles ClojureDart yet — there is no cljd
1616 toolchain in the flake and no Flutter SDK — so treat the interop here as the
1717 shape it should take rather than as code known to compile."
18- (:require ["dart:io" :as io]
18+ (:require ["dart:convert" :as conv]
19+ ["dart:io" :as io]
1920 [frq.io :as fio]))
2021
2122 (defonce ^:private uptime
@@ -51,6 +52,23 @@
5152 (.-timeZoneOffset)
5253 (.-inSeconds)))
5354
55+(defn- utf8-string
56+ "Byte values back to the text they spell.
57+
58+ The list is built typed rather than handed over as a cljd vector: Dart's
59+ `utf8.decode` wants a real `List<int>`, and a PersistentVector is not one —
60+ the same shape of mistake as the CastStream in `frq.net.dart`, where a
61+ generic lost through a dynamic call only shows up at runtime. `(.filled
62+ List n 0)` is how cljd.core itself makes one."
63+ [bs]
64+ (let [n (count bs)
65+ ^#/(List int) ary (.filled List n 0)]
66+ (loop [s (seq bs) i 0]
67+ (if (nil? s)
68+ (.decode conv/utf8 ary)
69+ (do (aset ary i (first s))
70+ (recur (next s) (inc i)))))))
71+
5472 (defn install!
5573 "`dir` is the app's storage directory, already awaited from path_provider."
5674 [dir]
@@ -65,6 +83,8 @@
6583 :slurp slurp*
6684 :spit spit*
6785 :write-private-file! write-private-file!
86+ :utf8-bytes (fn [s] (vec (.encode conv/utf8 (str s))))
87+ :utf8-string utf8-string
6888 :wall-nanos (fn [] (* 1000 (.-microsecondsSinceEpoch (DateTime/now))))
6989 :mono-nanos (fn [] (* 1000 (.-inMicroseconds (.-elapsed uptime))))
7090 :local-offset-seconds local-offset-seconds}))
@@ -15,7 +15,8 @@
15 UNVERIFIED. Nothing in this tree compiles ClojureDart yet — there is no cljd15 UNVERIFIED. Nothing in this tree compiles ClojureDart yet — there is no cljd
16 toolchain in the flake and no Flutter SDK — so treat the interop here as the16 toolchain in the flake and no Flutter SDK — so treat the interop here as the
17 shape it should take rather than as code known to compile."17 shape it should take rather than as code known to compile."
18- (:require ["dart:io" :as io]18+ (:require ["dart:convert" :as conv]
19+ ["dart:io" :as io]
19 [frq.io :as fio]))20 [frq.io :as fio]))
20 21
21 (defonce ^:private uptime22 (defonce ^:private uptime
@@ -51,6 +52,23 @@
51 (.-timeZoneOffset)52 (.-timeZoneOffset)
52 (.-inSeconds)))53 (.-inSeconds)))
53 54
55+(defn- utf8-string
56+ "Byte values back to the text they spell.
57+
58+ The list is built typed rather than handed over as a cljd vector: Dart's
59+ `utf8.decode` wants a real `List<int>`, and a PersistentVector is not one —
60+ the same shape of mistake as the CastStream in `frq.net.dart`, where a
61+ generic lost through a dynamic call only shows up at runtime. `(.filled
62+ List n 0)` is how cljd.core itself makes one."
63+ [bs]
64+ (let [n (count bs)
65+ ^#/(List int) ary (.filled List n 0)]
66+ (loop [s (seq bs) i 0]
67+ (if (nil? s)
68+ (.decode conv/utf8 ary)
69+ (do (aset ary i (first s))
70+ (recur (next s) (inc i)))))))
71+
54 (defn install!72 (defn install!
55 "`dir` is the app's storage directory, already awaited from path_provider."73 "`dir` is the app's storage directory, already awaited from path_provider."
56 [dir]74 [dir]
@@ -65,6 +83,8 @@
65 :slurp slurp*83 :slurp slurp*
66 :spit spit*84 :spit spit*
67 :write-private-file! write-private-file!85 :write-private-file! write-private-file!
86+ :utf8-bytes (fn [s] (vec (.encode conv/utf8 (str s))))
87+ :utf8-string utf8-string
68 :wall-nanos (fn [] (* 1000 (.-microsecondsSinceEpoch (DateTime/now))))88 :wall-nanos (fn [] (* 1000 (.-microsecondsSinceEpoch (DateTime/now))))
69 :mono-nanos (fn [] (* 1000 (.-inMicroseconds (.-elapsed uptime))))89 :mono-nanos (fn [] (* 1000 (.-inMicroseconds (.-elapsed uptime))))
70 :local-offset-seconds local-offset-seconds}))90 :local-offset-seconds local-offset-seconds}))
modified flutter/src/frq/main.cljd +31 -1
@@ -22,6 +22,7 @@
2222 [frq.hiccup :as h]
2323 [frq.io.dart :as host]
2424 [frq.net.dart :as net]
25+ [frq.atproto.dart :as atproto]
2526 [frq.clock :as clock]
2627 [frq.store :as store]))
2728
@@ -61,6 +62,25 @@
6162 (catch Exception e
6263 (reset! status (str "failed: " e)))))
6364
65+(defonce ^:private handle (atom "nandi-test.bsky.social"))
66+(defonce ^:private identity-out (atom nil))
67+
68+(defn ^:async resolve-identity!
69+ "handle → DID → PDS, over HTTPS from the phone.
70+
71+ The same three calls `frq.atproto` makes on the desktop, off the same
72+ `frq.atproto.core`: core says what to ask and what the answer means, and
73+ only who waits for it differs."
74+ []
75+ (reset! identity-out ["resolving…"])
76+ (try
77+ (let [h @handle
78+ did (await (atproto/resolve-handle h))
79+ pds (await (atproto/pds-endpoint did))]
80+ (reset! identity-out [(str "did " did) (str "pds " pds)]))
81+ (catch Exception e
82+ (reset! identity-out [(str "failed: " e)]))))
83+
6484 (defn- screen
6585 "glimmer's tags, painted by `frq.hiccup`. Nothing here is Flutter."
6686 []
@@ -85,6 +105,16 @@
85105 [:label {:label (str (:command m)
86106 (when-let [p (seq (:params m))]
87107 (str " " (last p))))}]]))]
108+ [:card {}
109+ [:title-2 {:label "Identity"}]
110+ [:entry {:key :handle
111+ :text @handle
112+ :placeholder "alice.bsky.social"
113+ :on-change #(reset! handle %)}]
114+ [:button {:label "Resolve" :primary true :on-click #(resolve-identity!)}]
115+ (when-let [out @identity-out]
116+ (for [[i line] (map-indexed vector out)]
117+ [:label {:key i :label line}]))]
88118 [:card {}
89119 [:title-2 {:label "Shared with the desktop"}]
90120 [:label {:label (str "clock " (clock/clock-time (clock/now-ms)))}]
@@ -108,6 +138,6 @@
108138 ;; rebuild, so the cells changed and the screen did not — which looks
109139 ;; exactly like a button that does not fire.
110140 (f/widget
111- :watch [st status ls lines]
141+ :watch [st status ls lines io identity-out hh handle]
112142 (m/SingleChildScrollView
113143 .child (h/render (screen)))))))
@@ -22,6 +22,7 @@
22 [frq.hiccup :as h]22 [frq.hiccup :as h]
23 [frq.io.dart :as host]23 [frq.io.dart :as host]
24 [frq.net.dart :as net]24 [frq.net.dart :as net]
25+ [frq.atproto.dart :as atproto]
25 [frq.clock :as clock]26 [frq.clock :as clock]
26 [frq.store :as store]))27 [frq.store :as store]))
27 28
@@ -61,6 +62,25 @@
61 (catch Exception e62 (catch Exception e
62 (reset! status (str "failed: " e)))))63 (reset! status (str "failed: " e)))))
63 64
65+(defonce ^:private handle (atom "nandi-test.bsky.social"))
66+(defonce ^:private identity-out (atom nil))
67+
68+(defn ^:async resolve-identity!
69+ "handle → DID → PDS, over HTTPS from the phone.
70+
71+ The same three calls `frq.atproto` makes on the desktop, off the same
72+ `frq.atproto.core`: core says what to ask and what the answer means, and
73+ only who waits for it differs."
74+ []
75+ (reset! identity-out ["resolving…"])
76+ (try
77+ (let [h @handle
78+ did (await (atproto/resolve-handle h))
79+ pds (await (atproto/pds-endpoint did))]
80+ (reset! identity-out [(str "did " did) (str "pds " pds)]))
81+ (catch Exception e
82+ (reset! identity-out [(str "failed: " e)]))))
83+
64 (defn- screen84 (defn- screen
65 "glimmer's tags, painted by `frq.hiccup`. Nothing here is Flutter."85 "glimmer's tags, painted by `frq.hiccup`. Nothing here is Flutter."
66 []86 []
@@ -85,6 +105,16 @@
85 [:label {:label (str (:command m)105 [:label {:label (str (:command m)
86 (when-let [p (seq (:params m))]106 (when-let [p (seq (:params m))]
87 (str " " (last p))))}]]))]107 (str " " (last p))))}]]))]
108+ [:card {}
109+ [:title-2 {:label "Identity"}]
110+ [:entry {:key :handle
111+ :text @handle
112+ :placeholder "alice.bsky.social"
113+ :on-change #(reset! handle %)}]
114+ [:button {:label "Resolve" :primary true :on-click #(resolve-identity!)}]
115+ (when-let [out @identity-out]
116+ (for [[i line] (map-indexed vector out)]
117+ [:label {:key i :label line}]))]
88 [:card {}118 [:card {}
89 [:title-2 {:label "Shared with the desktop"}]119 [:title-2 {:label "Shared with the desktop"}]
90 [:label {:label (str "clock " (clock/clock-time (clock/now-ms)))}]120 [:label {:label (str "clock " (clock/clock-time (clock/now-ms)))}]
@@ -108,6 +138,6 @@
108 ;; rebuild, so the cells changed and the screen did not — which looks138 ;; rebuild, so the cells changed and the screen did not — which looks
109 ;; exactly like a button that does not fire.139 ;; exactly like a button that does not fire.
110 (f/widget140 (f/widget
111- :watch [st status ls lines]141+ :watch [st status ls lines io identity-out hh handle]
112 (m/SingleChildScrollView142 (m/SingleChildScrollView
113 .child (h/render (screen)))))))143 .child (h/render (screen)))))))
modified src/frq/atproto.clj +36 -153
@@ -1,18 +1,28 @@
11 (ns frq.atproto
2- "The AT Protocol half of logging in: handle → DID → PDS → session token.
2+ "The desktop's AT Protocol: `frq.atproto.core` with a socket under it.
33
4- freeq's SASL mechanism takes a PDS access token and verifies it against the
5- DID document itself (`method: \"pds-session\"`), so this is all the identity
6- work the client has to do — no OAuth broker, no key material.
4+ The protocol itself moved to common/ — the JSON, the base64url, the SASL
5+ payloads, and a `-req`/`-parse` pair per step of the flow. What could not
6+ move is this: HTTPS hand-rolled over jolt.mvn-http's TLS bindings, because
7+ `fetch` there writes to a file and cannot POST. That is also why sign-in is
8+ desktop-only on jolt — there is no libssl to load on Android — and why the
9+ phone has `frq.atproto.dart`, where TLS is in the runtime.
710
8- HTTPS is hand-rolled over jolt.mvn-http's TLS bindings: `fetch` there writes
9- to a file and cannot POST. That also means login is desktop-only, for the
10- same reason TLS is — there is no libssl to load on Android."
11+ Everything in core is re-exported here, so the twenty-nine call sites that
12+ say `atproto/json-str` or `atproto/request` did not move."
1113 (:require [clojure.string :as str]
14+ [frq.atproto.core :as core]
1215 [jolt.mvn-http :as tls]))
1316
14-(def directory-host "public.api.bsky.app")
15-(def plc-host "plc.directory")
17+(def directory-host core/directory-host)
18+(def plc-host core/plc-host)
19+(def json-str core/json-str)
20+(def json-num core/json-num)
21+(def json-unescape core/json-unescape)
22+(def json-object core/json-object)
23+(def b64-encode core/b64-encode)
24+(def b64-decode core/b64-decode)
25+(def sasl-response core/sasl-response)
1626
1727 ;; ------------------------------------------------------------------ HTTP
1828
@@ -49,161 +59,34 @@
4959
5060 ;; ------------------------------------------------------------------ JSON
5161
52-(defn json-str
53- "The string value of a top-level JSON field, or nil.
54-
55- Enough of a parser for the four fields this namespace reads. Escapes are
56- passed through unchanged — none of a DID, a handle, a URL or a JWT contains
57- one."
58- [json field]
59- (let [m (re-find (re-pattern (str "\"" field "\"\\s*:\\s*\"([^\"]*)\"")) (or json ""))]
60- (second m)))
61-
62-(defn json-num
63- "The numeric value of a top-level JSON field, or nil.
64-
65- Written out as a string rather than parsed into a number: the counts on a
66- profile are only ever printed, and \"1204\" is what printing them wants."
67- [json field]
68- (second (re-find (re-pattern (str "\"" field "\"\\s*:\\s*(-?[0-9]+)")) (or json ""))))
69-
70-(defn json-unescape
71- "A JSON string body back to the text it stands for.
72-
73- `json-str` hands back the escapes as they were written, which is right for a
74- DID or a URL — none of them contains one — and wrong for a bio, where the
75- line breaks someone typed arrive as backslash-n. Only the escapes a bio can
76- carry are undone; a stray backslash is left alone rather than eaten."
77- [s]
78- (str/replace (or s "") #"\\(u[0-9a-fA-F]{4}|.)"
79- (fn [[whole esc]]
80- (case (first esc)
81- \n "\n"
82- \t "\t"
83- \r "\r"
84- \b "\b"
85- \f "\f"
86- \" "\""
87- \\ "\\"
88- \/ "/"
89- \u (str (char (Integer/parseInt (subs esc 1) 16)))
90- whole))))
91-
92-(defn- json-escape [s]
93- (-> (or s "")
94- (str/replace "\\" "\\\\")
95- (str/replace "\"" "\\\"")))
96-
97-(defn json-object
98- "A flat JSON object from a map of string keys to string values."
99- [m]
100- (str "{" (str/join "," (for [[k v] m] (str "\"" k "\":\"" (json-escape v) "\""))) "}"))
62+(defn- fetch
63+ "Perform one `-req` descriptor."
64+ [{:keys [host path body]}]
65+ (request host path body))
10166
10267 ;; ------------------------------------------------------------------ identity
68+;;
69+;; The flow, put back together: core says what to ask and what the answer
70+;; means, and this is the only part that touches a socket.
10371
10472 (defn resolve-handle
10573 "A handle (alice.bsky.social) to its DID. A DID passes through untouched."
10674 [handle]
107- (let [h (str/trim (or handle ""))]
108- (if (str/starts-with? h "did:")
109- h
110- (let [body (request directory-host
111- (str "/xrpc/com.atproto.identity.resolveHandle?handle=" h)
112- nil)]
113- (or (json-str body "did")
114- (throw (ex-info (str "Could not resolve handle " h) {:handle h :body body})))))))
75+ (core/resolve-handle-parse
76+ handle
77+ (when-let [req (core/resolve-handle-req handle)] (fetch req))))
11578
11679 (defn pds-endpoint
117- "The DID's PDS service endpoint, from its DID document.
118-
119- did:plc documents come from the PLC directory; did:web ones from the domain
120- itself, which is the whole of what did:web means."
80+ "The DID's PDS service endpoint, from its DID document."
12181 [did]
122- (let [doc (cond
123- (str/starts-with? did "did:plc:") (request plc-host (str "/" did) nil)
124- (str/starts-with? did "did:web:")
125- (request (subs did (count "did:web:")) "/.well-known/did.json" nil)
126- :else (throw (ex-info (str "Unsupported DID method: " did) {:did did})))
127- ;; The document lists several services; the PDS is the one whose entry
128- ;; carries a serviceEndpoint next to type AtprotoPersonalDataServer.
129- endpoint (or (second (re-find #"\"AtprotoPersonalDataServer\"\s*,\s*\"serviceEndpoint\"\s*:\s*\"([^\"]*)\"" doc))
130- (second (re-find #"\"serviceEndpoint\"\s*:\s*\"([^\"]*)\"[^}]*\"AtprotoPersonalDataServer\"" doc))
131- (json-str doc "serviceEndpoint"))]
132- (or endpoint
133- (throw (ex-info (str "No PDS endpoint for " did) {:did did})))))
134-
135-(defn- host-of [url]
136- (-> url (str/replace #"^https?://" "") (str/split #"/") first))
82+ (core/pds-endpoint-parse did (fetch (core/pds-doc-req did))))
13783
13884 (defn create-session
13985 "Sign in to the PDS with an app password. Returns
140- {:did :handle :access-jwt :pds}.
141-
142- The password goes to the user's own PDS and nowhere else — freeq never sees
143- it, and verifies the token it gets by asking that same PDS."
86+ {:did :handle :access-jwt :pds}."
14487 [identifier password]
14588 (let [did (resolve-handle identifier)
146- pds (pds-endpoint did)
147- body (request (host-of pds)
148- "/xrpc/com.atproto.server.createSession"
149- (json-object {"identifier" identifier "password" password}))
150- jwt (json-str body "accessJwt")]
151- (when-not jwt
152- (throw (ex-info (or (json-str body "message") "Sign-in failed") {:body body})))
153- {:did (or (json-str body "did") did)
154- :handle (or (json-str body "handle") identifier)
155- :access-jwt jwt
156- :pds pds}))
157-
158-;; ------------------------------------------------------------------ base64url
159-
160-(def ^:private alphabet
161- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
162-
163-(defn b64-encode
164- "base64url of a string, unpadded — what SASL and freeq's challenge use.
165- Hand-rolled rather than java.util.Base64: the host classes jolt registers are
166- not all there in a cross-compiled boot image, and this is three lines."
167- [s]
168- (let [bs (mapv #(bit-and (int %) 0xff) (.getBytes s))]
169- (apply str
170- (for [group (partition-all 3 bs)
171- :let [[a b c] group
172- n (count group)
173- v (+ (bit-shift-left a 16)
174- (bit-shift-left (or b 0) 8)
175- (or c 0))]
176- i (range (inc n))]
177- (nth alphabet (bit-and (bit-shift-right v (* 6 (- 3 i))) 0x3f))))))
178-
179-(defn b64-decode
180- "base64url back to a string. Padding is tolerated and ignored."
181- [s]
182- (let [idx (into {} (map-indexed (fn [i c] [c i]) alphabet))
183- vals (keep idx (remove #{\=} (seq (or s ""))))
184- bytes (for [group (partition-all 4 vals)
185- :let [n (count group)
186- v (reduce (fn [acc x] (+ (bit-shift-left acc 6) x))
187- 0
188- (concat group (repeat (- 4 n) 0)))]
189- i (range (dec n))]
190- (bit-and (bit-shift-right v (* 8 (- 2 i))) 0xff))]
191- (String. (byte-array (map unchecked-byte bytes)))))
192-
193-(defn sasl-response
194- "The base64url SASL payload for a session, either kind freeq takes.
195-
196- A `:pds-session` carries the PDS token, the DID it belongs to, its PDS, and
197- the server's own nonce echoed back so the token cannot be replayed at another
198- server. A `:web-token` from the auth broker carries only the token — the
199- server looks the DID up in its own token store, which is why the field is
200- sent empty rather than guessed at."
201- [session nonce]
202- (b64-encode
203- (if (= :web-token (:kind session))
204- (json-object {"did" "" "method" "web-token" "signature" (:token session)})
205- (json-object {"did" (:did session)
206- "signature" (:access-jwt session)
207- "method" "pds-session"
208- "pds_url" (:pds session)
209- "challenge_nonce" nonce}))))
89+ pds (pds-endpoint did)]
90+ (core/create-session-parse
91+ identifier did pds
92+ (fetch (core/create-session-req pds identifier password)))))
@@ -1,18 +1,28 @@
1 (ns frq.atproto1 (ns frq.atproto
2- "The AT Protocol half of logging in: handle → DID → PDS → session token.2+ "The desktop's AT Protocol: `frq.atproto.core` with a socket under it.
3 3
4- freeq's SASL mechanism takes a PDS access token and verifies it against the4+ The protocol itself moved to common/ — the JSON, the base64url, the SASL
5- DID document itself (`method: \"pds-session\"`), so this is all the identity5+ payloads, and a `-req`/`-parse` pair per step of the flow. What could not
6- work the client has to do — no OAuth broker, no key material.6+ move is this: HTTPS hand-rolled over jolt.mvn-http's TLS bindings, because
7+ `fetch` there writes to a file and cannot POST. That is also why sign-in is
8+ desktop-only on jolt — there is no libssl to load on Android — and why the
9+ phone has `frq.atproto.dart`, where TLS is in the runtime.
7 10
8- HTTPS is hand-rolled over jolt.mvn-http's TLS bindings: `fetch` there writes11+ Everything in core is re-exported here, so the twenty-nine call sites that
9- to a file and cannot POST. That also means login is desktop-only, for the12+ say `atproto/json-str` or `atproto/request` did not move."
10- same reason TLS is — there is no libssl to load on Android."
11 (:require [clojure.string :as str]13 (:require [clojure.string :as str]
14+ [frq.atproto.core :as core]
12 [jolt.mvn-http :as tls]))15 [jolt.mvn-http :as tls]))
13 16
14-(def directory-host "public.api.bsky.app")17+(def directory-host core/directory-host)
15-(def plc-host "plc.directory")18+(def plc-host core/plc-host)
19+(def json-str core/json-str)
20+(def json-num core/json-num)
21+(def json-unescape core/json-unescape)
22+(def json-object core/json-object)
23+(def b64-encode core/b64-encode)
24+(def b64-decode core/b64-decode)
25+(def sasl-response core/sasl-response)
16 26
17 ;; ------------------------------------------------------------------ HTTP27 ;; ------------------------------------------------------------------ HTTP
18 28
@@ -49,161 +59,34 @@
49 59
50 ;; ------------------------------------------------------------------ JSON60 ;; ------------------------------------------------------------------ JSON
51 61
52-(defn json-str62+(defn- fetch
53- "The string value of a top-level JSON field, or nil.63+ "Perform one `-req` descriptor."
54-64+ [{:keys [host path body]}]
55- Enough of a parser for the four fields this namespace reads. Escapes are65+ (request host path body))
56- passed through unchanged — none of a DID, a handle, a URL or a JWT contains
57- one."
58- [json field]
59- (let [m (re-find (re-pattern (str "\"" field "\"\\s*:\\s*\"([^\"]*)\"")) (or json ""))]
60- (second m)))
61-
62-(defn json-num
63- "The numeric value of a top-level JSON field, or nil.
64-
65- Written out as a string rather than parsed into a number: the counts on a
66- profile are only ever printed, and \"1204\" is what printing them wants."
67- [json field]
68- (second (re-find (re-pattern (str "\"" field "\"\\s*:\\s*(-?[0-9]+)")) (or json ""))))
69-
70-(defn json-unescape
71- "A JSON string body back to the text it stands for.
72-
73- `json-str` hands back the escapes as they were written, which is right for a
74- DID or a URL — none of them contains one — and wrong for a bio, where the
75- line breaks someone typed arrive as backslash-n. Only the escapes a bio can
76- carry are undone; a stray backslash is left alone rather than eaten."
77- [s]
78- (str/replace (or s "") #"\\(u[0-9a-fA-F]{4}|.)"
79- (fn [[whole esc]]
80- (case (first esc)
81- \n "\n"
82- \t "\t"
83- \r "\r"
84- \b "\b"
85- \f "\f"
86- \" "\""
87- \\ "\\"
88- \/ "/"
89- \u (str (char (Integer/parseInt (subs esc 1) 16)))
90- whole))))
91-
92-(defn- json-escape [s]
93- (-> (or s "")
94- (str/replace "\\" "\\\\")
95- (str/replace "\"" "\\\"")))
96-
97-(defn json-object
98- "A flat JSON object from a map of string keys to string values."
99- [m]
100- (str "{" (str/join "," (for [[k v] m] (str "\"" k "\":\"" (json-escape v) "\""))) "}"))
101 66
102 ;; ------------------------------------------------------------------ identity67 ;; ------------------------------------------------------------------ identity
68+;;
69+;; The flow, put back together: core says what to ask and what the answer
70+;; means, and this is the only part that touches a socket.
103 71
104 (defn resolve-handle72 (defn resolve-handle
105 "A handle (alice.bsky.social) to its DID. A DID passes through untouched."73 "A handle (alice.bsky.social) to its DID. A DID passes through untouched."
106 [handle]74 [handle]
107- (let [h (str/trim (or handle ""))]75+ (core/resolve-handle-parse
108- (if (str/starts-with? h "did:")76+ handle
109- h77+ (when-let [req (core/resolve-handle-req handle)] (fetch req))))
110- (let [body (request directory-host
111- (str "/xrpc/com.atproto.identity.resolveHandle?handle=" h)
112- nil)]
113- (or (json-str body "did")
114- (throw (ex-info (str "Could not resolve handle " h) {:handle h :body body})))))))
115 78
116 (defn pds-endpoint79 (defn pds-endpoint
117- "The DID's PDS service endpoint, from its DID document.80+ "The DID's PDS service endpoint, from its DID document."
118-
119- did:plc documents come from the PLC directory; did:web ones from the domain
120- itself, which is the whole of what did:web means."
121 [did]81 [did]
122- (let [doc (cond82+ (core/pds-endpoint-parse did (fetch (core/pds-doc-req did))))
123- (str/starts-with? did "did:plc:") (request plc-host (str "/" did) nil)
124- (str/starts-with? did "did:web:")
125- (request (subs did (count "did:web:")) "/.well-known/did.json" nil)
126- :else (throw (ex-info (str "Unsupported DID method: " did) {:did did})))
127- ;; The document lists several services; the PDS is the one whose entry
128- ;; carries a serviceEndpoint next to type AtprotoPersonalDataServer.
129- endpoint (or (second (re-find #"\"AtprotoPersonalDataServer\"\s*,\s*\"serviceEndpoint\"\s*:\s*\"([^\"]*)\"" doc))
130- (second (re-find #"\"serviceEndpoint\"\s*:\s*\"([^\"]*)\"[^}]*\"AtprotoPersonalDataServer\"" doc))
131- (json-str doc "serviceEndpoint"))]
132- (or endpoint
133- (throw (ex-info (str "No PDS endpoint for " did) {:did did})))))
134-
135-(defn- host-of [url]
136- (-> url (str/replace #"^https?://" "") (str/split #"/") first))
137 83
138 (defn create-session84 (defn create-session
139 "Sign in to the PDS with an app password. Returns85 "Sign in to the PDS with an app password. Returns
140- {:did :handle :access-jwt :pds}.86+ {:did :handle :access-jwt :pds}."
141-
142- The password goes to the user's own PDS and nowhere else — freeq never sees
143- it, and verifies the token it gets by asking that same PDS."
144 [identifier password]87 [identifier password]
145 (let [did (resolve-handle identifier)88 (let [did (resolve-handle identifier)
146- pds (pds-endpoint did)89+ pds (pds-endpoint did)]
147- body (request (host-of pds)90+ (core/create-session-parse
148- "/xrpc/com.atproto.server.createSession"91+ identifier did pds
149- (json-object {"identifier" identifier "password" password}))92+ (fetch (core/create-session-req pds identifier password)))))
150- jwt (json-str body "accessJwt")]
151- (when-not jwt
152- (throw (ex-info (or (json-str body "message") "Sign-in failed") {:body body})))
153- {:did (or (json-str body "did") did)
154- :handle (or (json-str body "handle") identifier)
155- :access-jwt jwt
156- :pds pds}))
157-
158-;; ------------------------------------------------------------------ base64url
159-
160-(def ^:private alphabet
161- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
162-
163-(defn b64-encode
164- "base64url of a string, unpadded — what SASL and freeq's challenge use.
165- Hand-rolled rather than java.util.Base64: the host classes jolt registers are
166- not all there in a cross-compiled boot image, and this is three lines."
167- [s]
168- (let [bs (mapv #(bit-and (int %) 0xff) (.getBytes s))]
169- (apply str
170- (for [group (partition-all 3 bs)
171- :let [[a b c] group
172- n (count group)
173- v (+ (bit-shift-left a 16)
174- (bit-shift-left (or b 0) 8)
175- (or c 0))]
176- i (range (inc n))]
177- (nth alphabet (bit-and (bit-shift-right v (* 6 (- 3 i))) 0x3f))))))
178-
179-(defn b64-decode
180- "base64url back to a string. Padding is tolerated and ignored."
181- [s]
182- (let [idx (into {} (map-indexed (fn [i c] [c i]) alphabet))
183- vals (keep idx (remove #{\=} (seq (or s ""))))
184- bytes (for [group (partition-all 4 vals)
185- :let [n (count group)
186- v (reduce (fn [acc x] (+ (bit-shift-left acc 6) x))
187- 0
188- (concat group (repeat (- 4 n) 0)))]
189- i (range (dec n))]
190- (bit-and (bit-shift-right v (* 8 (- 2 i))) 0xff))]
191- (String. (byte-array (map unchecked-byte bytes)))))
192-
193-(defn sasl-response
194- "The base64url SASL payload for a session, either kind freeq takes.
195-
196- A `:pds-session` carries the PDS token, the DID it belongs to, its PDS, and
197- the server's own nonce echoed back so the token cannot be replayed at another
198- server. A `:web-token` from the auth broker carries only the token — the
199- server looks the DID up in its own token store, which is why the field is
200- sent empty rather than guessed at."
201- [session nonce]
202- (b64-encode
203- (if (= :web-token (:kind session))
204- (json-object {"did" "" "method" "web-token" "signature" (:token session)})
205- (json-object {"did" (:did session)
206- "signature" (:access-jwt session)
207- "method" "pds-session"
208- "pds_url" (:pds session)
209- "challenge_nonce" nonce}))))
modified src/frq/io/jolt.clj +2 -0
@@ -73,6 +73,8 @@
7373 :slurp slurp*
7474 :spit spit*
7575 :write-private-file! write-private-file!
76+ :utf8-bytes (fn [s] (mapv #(bit-and (int %) 0xff) (.getBytes (str s))))
77+ :utf8-string (fn [bs] (String. (byte-array (map unchecked-byte bs))))
7678 :wall-nanos host/wall-nanos
7779 :mono-nanos host/mono-nanos
7880 :local-offset-seconds (fn [secs] (host/tz-offset-seconds @zone secs))})
@@ -73,6 +73,8 @@
73 :slurp slurp*73 :slurp slurp*
74 :spit spit*74 :spit spit*
75 :write-private-file! write-private-file!75 :write-private-file! write-private-file!
76+ :utf8-bytes (fn [s] (mapv #(bit-and (int %) 0xff) (.getBytes (str s))))
77+ :utf8-string (fn [bs] (String. (byte-array (map unchecked-byte bs))))
76 :wall-nanos host/wall-nanos78 :wall-nanos host/wall-nanos
77 :mono-nanos host/mono-nanos79 :mono-nanos host/mono-nanos
78 :local-offset-seconds (fn [secs] (host/tz-offset-seconds @zone secs))})80 :local-offset-seconds (fn [secs] (host/tz-offset-seconds @zone secs))})
modified src/frq/oauth.clj +14 -53
@@ -11,6 +11,7 @@
1111 `broker_token`. The web-token is single-use: `/session` mints a fresh one
1212 from the broker token on every later connection."
1313 (:require [clojure.string :as str]
14+ [frq.oauth.core :as core]
1415 [frq.atproto :as atproto]
1516 [frq.platform :as platform]
1617 [frq.wire :as wire]
@@ -18,25 +19,16 @@
1819 [jolt.host :as host]
1920 [jolt.socket :as socket]))
2021
21-(def default-broker "https://auth.freeq.at")
22-
2322 ;; ------------------------------------------------------------------ urls
23+;;
24+;; Moved to `frq.oauth.core` under common/, which is everything about this
25+;; flow that is not the waiting: the URL, the payload, the session refresh.
26+;; Re-exported so callers did not move.
2427
25-(defn url-encode
26- "Percent-encode everything a handle could hold that a query string cannot."
27- [s]
28- (apply str
29- (for [b (.getBytes (or s ""))
30- :let [c (char (bit-and (int b) 0xff))]]
31- (if (or (Character/isLetterOrDigit c) (#{\- \_ \. \~} c))
32- c
33- (format "%%%02X" (bit-and (int b) 0xff))))))
34-
35-(defn login-url [broker handle return-to]
36- (let [base (str/replace (or broker default-broker) #"/+$" "")
37- handle (-> (or handle "") str/trim (str/replace #"^@" ""))]
38- (str base "/auth/login?handle=" (url-encode handle)
39- "&return_to=" (url-encode return-to))))
28+(def default-broker core/default-broker)
29+(def url-encode core/url-encode)
30+(def login-url core/login-url)
31+(def tokens-of core/tokens-of)
4032
4133 (defn open-browser!
4234 "Hand the URL to the desktop. A failure here is not fatal — the caller shows
@@ -110,22 +102,6 @@
110102 [fd port]
111103 (do (socket/c-close fd) (recur (inc port)))))))
112104
113-(defn tokens-of
114- "The broker's base64url JSON payload as {:token :broker-token :nick :did
115- :handle}."
116- [payload]
117- (let [json (atproto/b64-decode (str/trim payload))
118- token (atproto/json-str json "token")
119- broker (atproto/json-str json "broker_token")]
120- (when-not (and token broker)
121- (throw (ex-info (or (atproto/json-str json "error") "Malformed sign-in payload")
122- {:body json})))
123- {:token token
124- :broker-token broker
125- :nick (atproto/json-str json "nick")
126- :did (atproto/json-str json "did")
127- :handle (or (atproto/json-str json "handle") "")}))
128-
129105 (defn await-callback!
130106 "Serve the loopback capture until the browser posts the handoff back.
131107
@@ -158,25 +134,10 @@
158134
159135 ;; ------------------------------------------------------------------ session
160136
161-(defn- broker-host [broker]
162- (-> (or broker default-broker)
163- (str/replace #"^https?://" "")
164- (str/split #"/")
165- first))
166-
167137 (defn refresh-session
168- "Mint a fresh single-use web-token from the durable broker token. This is
169- what a reconnect uses; the token from the browser handoff is spent."
138+ "Mint a fresh single-use web-token from the durable broker token."
170139 [broker broker-token]
171- (let [body (atproto/request (broker-host broker) "/session"
172- (atproto/json-object {"broker_token" broker-token}))
173- token (atproto/json-str body "token")]
174- (when-not token
175- (throw (ex-info (or (atproto/json-str body "message")
176- "Broker session refresh failed — sign in again")
177- {:body body})))
178- {:token token
179- :broker-token broker-token
180- :nick (atproto/json-str body "nick")
181- :did (atproto/json-str body "did")
182- :handle (or (atproto/json-str body "handle") "")}))
140+ (core/refresh-session-parse
141+ broker-token
142+ (let [{:keys [host path body]} (core/refresh-session-req broker broker-token)]
143+ (atproto/request host path body))))
@@ -11,6 +11,7 @@
11 `broker_token`. The web-token is single-use: `/session` mints a fresh one11 `broker_token`. The web-token is single-use: `/session` mints a fresh one
12 from the broker token on every later connection."12 from the broker token on every later connection."
13 (:require [clojure.string :as str]13 (:require [clojure.string :as str]
14+ [frq.oauth.core :as core]
14 [frq.atproto :as atproto]15 [frq.atproto :as atproto]
15 [frq.platform :as platform]16 [frq.platform :as platform]
16 [frq.wire :as wire]17 [frq.wire :as wire]
@@ -18,25 +19,16 @@
18 [jolt.host :as host]19 [jolt.host :as host]
19 [jolt.socket :as socket]))20 [jolt.socket :as socket]))
20 21
21-(def default-broker "https://auth.freeq.at")
22-
23 ;; ------------------------------------------------------------------ urls22 ;; ------------------------------------------------------------------ urls
23+;;
24+;; Moved to `frq.oauth.core` under common/, which is everything about this
25+;; flow that is not the waiting: the URL, the payload, the session refresh.
26+;; Re-exported so callers did not move.
24 27
25-(defn url-encode28+(def default-broker core/default-broker)
26- "Percent-encode everything a handle could hold that a query string cannot."29+(def url-encode core/url-encode)
27- [s]30+(def login-url core/login-url)
28- (apply str31+(def tokens-of core/tokens-of)
29- (for [b (.getBytes (or s ""))
30- :let [c (char (bit-and (int b) 0xff))]]
31- (if (or (Character/isLetterOrDigit c) (#{\- \_ \. \~} c))
32- c
33- (format "%%%02X" (bit-and (int b) 0xff))))))
34-
35-(defn login-url [broker handle return-to]
36- (let [base (str/replace (or broker default-broker) #"/+$" "")
37- handle (-> (or handle "") str/trim (str/replace #"^@" ""))]
38- (str base "/auth/login?handle=" (url-encode handle)
39- "&return_to=" (url-encode return-to))))
40 32
41 (defn open-browser!33 (defn open-browser!
42 "Hand the URL to the desktop. A failure here is not fatal — the caller shows34 "Hand the URL to the desktop. A failure here is not fatal — the caller shows
@@ -110,22 +102,6 @@
110 [fd port]102 [fd port]
111 (do (socket/c-close fd) (recur (inc port)))))))103 (do (socket/c-close fd) (recur (inc port)))))))
112 104
113-(defn tokens-of
114- "The broker's base64url JSON payload as {:token :broker-token :nick :did
115- :handle}."
116- [payload]
117- (let [json (atproto/b64-decode (str/trim payload))
118- token (atproto/json-str json "token")
119- broker (atproto/json-str json "broker_token")]
120- (when-not (and token broker)
121- (throw (ex-info (or (atproto/json-str json "error") "Malformed sign-in payload")
122- {:body json})))
123- {:token token
124- :broker-token broker
125- :nick (atproto/json-str json "nick")
126- :did (atproto/json-str json "did")
127- :handle (or (atproto/json-str json "handle") "")}))
128-
129 (defn await-callback!105 (defn await-callback!
130 "Serve the loopback capture until the browser posts the handoff back.106 "Serve the loopback capture until the browser posts the handoff back.
131 107
@@ -158,25 +134,10 @@
158 134
159 ;; ------------------------------------------------------------------ session135 ;; ------------------------------------------------------------------ session
160 136
161-(defn- broker-host [broker]
162- (-> (or broker default-broker)
163- (str/replace #"^https?://" "")
164- (str/split #"/")
165- first))
166-
167 (defn refresh-session137 (defn refresh-session
168- "Mint a fresh single-use web-token from the durable broker token. This is138+ "Mint a fresh single-use web-token from the durable broker token."
169- what a reconnect uses; the token from the browser handoff is spent."
170 [broker broker-token]139 [broker broker-token]
171- (let [body (atproto/request (broker-host broker) "/session"140+ (core/refresh-session-parse
172- (atproto/json-object {"broker_token" broker-token}))141+ broker-token
173- token (atproto/json-str body "token")]142+ (let [{:keys [host path body]} (core/refresh-session-req broker broker-token)]
174- (when-not token143+ (atproto/request host path body))))
175- (throw (ex-info (or (atproto/json-str body "message")
176- "Broker session refresh failed — sign in again")
177- {:body body})))
178- {:token token
179- :broker-token broker-token
180- :nick (atproto/json-str body "nick")
181- :did (atproto/json-str body "did")
182- :handle (or (atproto/json-str body "handle") "")}))