Add read-only Proton metadata commands
ober
4f10f8dcdf9402941f91fa6cf5991826863d6515
--- a/README.md +++ b/README.md @@ -83,6 +83,9 @@ Current `login` support includes live auth and two offline probes: ```sh make run ARGS='login --username USER' +make run ARGS='folders --username USER' +make run ARGS='list --username USER --folder INBOX --limit 20' +make run ARGS='message-json --username USER --id MESSAGE_ID' make run ARGS='login --auth-info auth-info.json --username USER' make run ARGS='login --auth-options auth-options.json' ``` @@ -92,6 +95,10 @@ proof, verifies Proton's `ServerProof`, and then submits a YubiKey-backed FIDO2 assertion when Proton requires FIDO2. It prints only the authenticated UID and does not persist the session. +The read-only `folders`, `list`, and `message-json` commands perform a fresh +interactive auth for each invocation. They fetch Proton API JSON directly and +do not store a reusable refresh token or local IMAP password. + `auth-info.json` is the `/auth/v4/info` response. The command prompts for the Proton password and emits the SRP `/auth/v4` request body plus the expected server proof to verify after Proton responds. --- a/plan.md +++ b/plan.md @@ -286,6 +286,14 @@ Deliverables: - List message metadata. - Render summary table. +Done: + +- In-memory session record built from authenticated Proton auth response. +- Authenticated read-only API calls for user, salts, addresses, folders, + message metadata, and one raw message JSON object. +- `folders --username USER`, `list --username USER --folder INBOX --limit N`, + and `message-json --username USER --id MESSAGE_ID`. + Exit criteria: - Can list inbox metadata after FIDO-gated login. @@ -334,7 +342,7 @@ Rejected default: Continue M2 in this repository: -1. Run a manual live login against the user's Proton account and registered - YubiKey. +1. Run manual live auth and metadata checks against the user's Proton account + and registered YubiKey. 2. Add TOTP fallback only if needed. -3. After live login succeeds, start M3 key unlock. +3. Continue M3/M5 key unlock and decrypted message rendering. --- a/proton-bridge/api/http.ss +++ b/proton-bridge/api/http.ss @@ -8,6 +8,8 @@ proton-api-url proton-api-default-headers proton-api-auth-headers + proton-api-header + proton-api-get-json proton-api-post-json) (import (except (chezscheme) @@ -56,22 +58,22 @@ (string-append base path) (string-append base "/" path)))) - (def (header name value) + (def (proton-api-header name value) (list name ':: value)) (def (proton-api-default-headers) (list - (header "Accept" "application/json") - (header "Content-Type" "application/json") - (header "User-Agent" "jerboa-proton-bridge") - (header "x-pm-appversion" default-proton-app-version))) + (proton-api-header "Accept" "application/json") + (proton-api-header "Content-Type" "application/json") + (proton-api-header "User-Agent" "jerboa-proton-bridge") + (proton-api-header "x-pm-appversion" default-proton-app-version))) (def (proton-api-auth-headers uid access-token) (append (proton-api-default-headers) (list - (header "x-pm-uid" uid) - (header "Authorization" (string-append "Bearer " access-token))))) + (proton-api-header "x-pm-uid" uid) + (proton-api-header "Authorization" (string-append "Bearer " access-token))))) (def (getopt opts kw default) (let loop ([xs opts]) @@ -101,24 +103,42 @@ (def (success-status? status) (and (>= status 200) (< status 300))) - (def (proton-api-post-json path payload . opts) + (def (api-request-headers uid access-token extra-headers) + (append + (if (and uid access-token) + (proton-api-auth-headers uid access-token) + (proton-api-default-headers)) + extra-headers)) + + (def (proton-api-request-json method path payload . opts) (let* ([base-url (getopt opts 'base-url: default-proton-api-base-url)] [uid (getopt opts 'uid: #f)] [access-token (getopt opts 'access-token: #f)] - [headers (if (and uid access-token) - (proton-api-auth-headers uid access-token) - (proton-api-default-headers))] + [extra-headers (getopt opts 'headers: '())] + [params (getopt opts 'params: #f)] + [headers (api-request-headers uid access-token extra-headers)] [url (proton-api-url base-url path)] - [body (json-object->string payload)] - [req (http-post url - 'headers: headers - 'params: #f - 'data: (string->utf8 body))] + [req (case method + [(GET) + (http-get url 'headers: headers 'params: params)] + [(POST) + (http-post url + 'headers: headers + 'params: params + 'data: (string->utf8 (json-object->string payload)))] + [else + (error 'proton-api-request-json "unsupported method" method)])] [status (request-status req)] [text (request-text req)]) (request-close req) (if (success-status? status) (parse-json-or-empty text) - (error 'proton-api-post-json (response-error-message status text))))) + (error 'proton-api-request-json (response-error-message status text))))) + + (def (proton-api-get-json path . opts) + (apply proton-api-request-json 'GET path #f opts)) + + (def (proton-api-post-json path payload . opts) + (apply proton-api-request-json 'POST path payload opts)) ) new file mode 100644 --- /dev/null +++ b/proton-bridge/api/mail.ss @@ -0,0 +1,189 @@ +#!chezscheme +;;; (proton-bridge api mail) - read-only Proton Mail API calls. + +(library (proton-bridge api mail) + (export + proton-mail-get-user + proton-mail-get-salts + proton-mail-get-addresses + proton-mail-get-labels + proton-mail-get-folders + proton-mail-system-label-id + proton-mail-resolve-label-id + proton-mail-get-message-metadata-page + proton-mail-get-message) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (proton-bridge api http) + (proton-bridge api session)) + + (def (json-object . fields) + (let ([ht (make-hash-table)]) + (let loop ([xs fields]) + (unless (null? xs) + (hash-put! ht (car xs) (cadr xs)) + (loop (cddr xs)))) + ht)) + + (def (jref who obj key) + (unless (hash-table? obj) + (error who "expected JSON object while reading" key)) + (let ([value (hash-ref obj key #f)]) + (unless value + (error who "missing JSON field" key)) + value)) + + (def (jmaybe obj key) + (and (hash-table? obj) (hash-ref obj key #f))) + + (def (session-get session path . opts) + (apply proton-api-get-json + path + (append + (list 'base-url: (proton-session-base-url session) + 'uid: (proton-session-uid session) + 'access-token: (proton-session-access-token session)) + opts))) + + (def (session-post session path payload . opts) + (apply proton-api-post-json + path + payload + (append + (list 'base-url: (proton-session-base-url session) + 'uid: (proton-session-uid session) + 'access-token: (proton-session-access-token session)) + opts))) + + (def (proton-mail-get-user session) + (jref 'proton-mail-get-user + (session-get session "/core/v4/users") + "User")) + + (def (proton-mail-get-salts session) + (jref 'proton-mail-get-salts + (session-get session "/core/v4/keys/salts") + "KeySalts")) + + (def (proton-mail-get-addresses session) + (jref 'proton-mail-get-addresses + (session-get session "/core/v4/addresses") + "Addresses")) + + (def (labels-of-type session label-type) + (jref 'proton-mail-get-labels + (session-get session + "/core/v4/labels" + 'params: + (list + (proton-api-header "Type" + (number->string label-type)))) + "Labels")) + + (def (api-append-map f xs) + (let loop ([xs xs] [acc '()]) + (if (null? xs) + (reverse acc) + (loop (cdr xs) (append (reverse (f (car xs))) acc))))) + + ;; Proton label types: 1 label/tag, 3 folder, 4 system. + (def (proton-mail-get-labels session . label-types) + (api-append-map + (lambda (label-type) (labels-of-type session label-type)) + (if (null? label-types) '(1 3 4) label-types))) + + (def (proton-mail-get-folders session) + (proton-mail-get-labels session 3 4)) + + (def (proton-mail-system-label-id name) + (let ([key (string-downcase name)]) + (cond + [(or (string=? key "inbox") (string=? key "0")) "0"] + [(or (string=? key "all-drafts") (string=? key "all drafts") + (string=? key "1")) "1"] + [(or (string=? key "all-sent") (string=? key "all sent") + (string=? key "2")) "2"] + [(or (string=? key "trash") (string=? key "3")) "3"] + [(or (string=? key "spam") (string=? key "4")) "4"] + [(or (string=? key "all-mail") (string=? key "all mail") + (string=? key "5")) "5"] + [(or (string=? key "archive") (string=? key "6")) "6"] + [(or (string=? key "sent") (string=? key "7")) "7"] + [(or (string=? key "drafts") (string=? key "8")) "8"] + [(or (string=? key "outbox") (string=? key "9")) "9"] + [(or (string=? key "starred") (string=? key "10")) "10"] + [(or (string=? key "scheduled") (string=? key "all-scheduled") + (string=? key "12")) "12"] + [else #f]))) + + (def (label-name label) + (or (jmaybe label "Name") "")) + + (def (label-id label) + (jmaybe label "ID")) + + (def (label-path label) + (let ([path (jmaybe label "Path")]) + (cond + [(string? path) path] + [(and (list? path) (not (null? path))) + (let loop ([xs (cdr path)] [acc (car path)]) + (if (null? xs) + acc + (loop (cdr xs) (string-append acc "/" (car xs)))))] + [else ""]))) + + (def (label-matches? label target) + (let ([key (string-downcase target)] + [id (label-id label)] + [name (label-name label)] + [path (label-path label)]) + (or (and id (string=? id target)) + (string=? (string-downcase name) key) + (and (> (string-length path) 0) + (string=? (string-downcase path) key))))) + + (def (proton-mail-resolve-label-id labels folder) + (or (proton-mail-system-label-id folder) + (let loop ([xs labels]) + (cond + [(null? xs) + (error 'proton-mail-resolve-label-id + "unknown Proton folder/label" folder)] + [(label-matches? (car xs) folder) + (label-id (car xs))] + [else (loop (cdr xs))])))) + + (def (proton-mail-get-message-metadata-page session label-id page page-size) + (let ([payload (json-object + "LabelID" label-id + "Desc" 1 + "Page" page + "PageSize" page-size + "Sort" "ID")]) + (jref 'proton-mail-get-message-metadata-page + (session-post session + "/mail/v4/messages" + payload + 'headers: + (list + (proton-api-header "X-HTTP-Method-Override" + "GET"))) + "Messages"))) + + (def (proton-mail-get-message session message-id) + (jref 'proton-mail-get-message + (session-get session + (string-append "/mail/v4/messages/" message-id)) + "Message")) + + ) new file mode 100644 --- /dev/null +++ b/proton-bridge/api/session.ss @@ -0,0 +1,42 @@ +#!chezscheme +;;; (proton-bridge api session) - in-memory Proton session record. + +(library (proton-bridge api session) + (export + proton-session? + make-proton-session + proton-session-base-url + proton-session-uid + proton-session-access-token + proton-session-refresh-token + proton-session-auth + proton-session-from-auth) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (proton-bridge api auth)) + + (defstruct proton-session + (base-url + uid + access-token + refresh-token + auth)) + + (def (proton-session-from-auth base-url auth) + (make-proton-session + base-url + (proton-auth-uid auth) + (proton-auth-access-token auth) + (proton-auth-refresh-token auth) + auth)) + + ) --- a/proton-bridge/cli.ss +++ b/proton-bridge/cli.ss @@ -13,10 +13,12 @@ iota 1+ 1- partition make-date make-time) - (only (std text json) string->json-object) + (only (std text json) string->json-object json-object->string) (proton-bridge security) (proton-bridge api auth) (proton-bridge api http) + (proton-bridge api mail) + (proton-bridge api session) (proton-bridge fido2) (proton-bridge srp) (only (yubikey fido2) fido2-assertion-credential-id)) @@ -30,8 +32,9 @@ "commands:\n" " status Show rewrite/security status\n" " login Native Proton login probes\n" - " folders List Proton folders (planned)\n" - " list List messages (planned)\n" + " folders List Proton folders after fresh auth\n" + " list List message metadata after fresh auth\n" + " message-json Fetch one raw Proton message JSON object\n" " show Fetch/decrypt/show one message (planned)\n" " help Print this help\n" " version Print version\n")) @@ -40,6 +43,10 @@ (display s) (newline)) + (define (eprintln s) + (display s (current-error-port)) + (newline (current-error-port))) + (define (die code msg) (display msg (current-error-port)) (newline (current-error-port)) @@ -122,6 +129,41 @@ (die 2 (string-append "environment variable is unset: " env-name)))] [else (read-secret "Proton password: ")]))) + (define (auth-base-url opts) + (or (opt opts "--base-url") default-proton-api-base-url)) + + (define (auth-username opts) + (let ([username (opt opts "--username")]) + (unless username + (die 2 "auth requires --username USER")) + username)) + + (define (authenticated-session-from-options opts) + (let* ([username (auth-username opts)] + [base-url (auth-base-url opts)] + [password (read-password-from-options opts)]) + (eprintln "Requesting Proton SRP challenge.") + (let ([auth-info (proton-auth-info username 'base-url: base-url)]) + (eprintln "Submitting Proton SRP proof.") + (call-with-values + (lambda () (proton-auth-submit auth-info username password 'base-url: base-url)) + (lambda (proofs auth) + (cond + [(proton-auth-fido2-required? auth) + (let ([pin (if (opt opts "--prompt-pin") + (read-secret "FIDO2 PIN: ") + "")]) + (eprintln "Touch your YubiKey when it blinks.") + (call-with-values + (lambda () (proton-fido2-assert auth 'pin: pin)) + (lambda (auth-data assertion payload-json) + (proton-auth-submit-fido2 auth payload-json 'base-url: base-url) + (proton-session-from-auth base-url auth))))] + [(proton-auth-totp-required? auth) + (die 2 "TOTP 2FA is required, but TOTP submission is not implemented yet")] + [else + (proton-session-from-auth base-url auth)])))))) + (define (cmd-login-srp auth-info-file opts) (let ([username (opt opts "--username")]) (unless username @@ -137,34 +179,122 @@ (proton-srp-proofs-expected-server-proof proofs)))))))) (define (cmd-login-live opts) - (let* ([username (opt opts "--username")] - [base-url (or (opt opts "--base-url") default-proton-api-base-url)]) - (unless username - (die 2 "login requires --username USER")) - (let ([password (read-password-from-options opts)]) - (println "Requesting Proton SRP challenge.") - (let ([auth-info (proton-auth-info username 'base-url: base-url)]) - (println "Submitting Proton SRP proof.") - (call-with-values - (lambda () (proton-auth-submit auth-info username password 'base-url: base-url)) - (lambda (proofs auth) - (cond - [(proton-auth-fido2-required? auth) - (let ([pin (if (opt opts "--prompt-pin") - (read-secret "FIDO2 PIN: ") - "")]) - (println "Touch your YubiKey when it blinks.") - (call-with-values - (lambda () (proton-fido2-assert auth 'pin: pin)) - (lambda (auth-data assertion payload-json) - (proton-auth-submit-fido2 auth payload-json 'base-url: base-url) - (println - (string-append "authenticated UID: " (proton-auth-uid auth))))))] - [(proton-auth-totp-required? auth) - (die 2 "TOTP 2FA is required, but TOTP submission is not implemented yet")] - [else - (println - (string-append "authenticated UID: " (proton-auth-uid auth)))]))))))) + (let ([session (authenticated-session-from-options opts)]) + (println + (string-append "authenticated UID: " (proton-session-uid session))))) + + (define (option-number opts name default) + (let* ([raw (opt opts name)] + [n (and raw (string->number raw))]) + (cond + [(not raw) default] + [(and n (integer? n) (> n 0)) n] + [else (die 2 (string-append "invalid number for " name))]))) + + (define (json-ref obj key default) + (if (hashtable? obj) + (hashtable-ref obj key default) + default)) + + (define (json-value->string value) + (cond + [(not value) ""] + [(string? value) value] + [(number? value) (number->string value)] + [(boolean? value) (if value "true" "false")] + [else (format "~s" value)])) + + (define (join-strings xs sep) + (cond + [(null? xs) ""] + [else + (let loop ([rest (cdr xs)] [acc (car xs)]) + (if (null? rest) + acc + (loop (cdr rest) (string-append acc sep (car rest)))))])) + + (define (label-path-string label) + (let ([path (json-ref label "Path" "")]) + (cond + [(string? path) path] + [(and (list? path) (not (null? path))) (join-strings path "/")] + [else ""]))) + + (define (print-folder-row label) + (println + (string-append + (json-value->string (json-ref label "ID" "")) + "\t" + (json-value->string (json-ref label "Type" "")) + "\t" + (json-value->string (json-ref label "Name" "")) + "\t" + (label-path-string label)))) + + (define (cmd-folders opts) + (let* ([session (authenticated-session-from-options opts)] + [folders (proton-mail-get-folders session)]) + (println "ID\tType\tName\tPath") + (for-each print-folder-row folders))) + + (define (mail-address->string value) + (cond + [(not value) ""] + [(string? value) value] + [(hashtable? value) + (let ([name (json-ref value "Name" "")] + [address (json-ref value "Address" "")]) + (cond + [(and (> (string-length name) 0) + (> (string-length address) 0)) + (string-append name " <" address ">")] + [(> (string-length address) 0) address] + [else name]))] + [else (format "~s" value)])) + + (define (message-row message) + (println + (string-append + (json-value->string (json-ref message "ID" "")) + "\t" + (json-value->string (json-ref message "Time" "")) + "\t" + (json-value->string (json-ref message "Unread" "")) + "\t" + (mail-address->string (json-ref message "Sender" #f)) + "\t" + (json-value->string (json-ref message "Subject" ""))))) + + (define (cmd-list args) + (let* ([parsed (split-opts args auth-known-options)] + [opts (car parsed)] + [folder (or (opt opts "--folder") "INBOX")] + [limit (option-number opts "--limit" 20)] + [session (authenticated-session-from-options opts)] + [folders (proton-mail-get-folders session)] + [label-id (proton-mail-resolve-label-id folders folder)] + [messages (proton-mail-get-message-metadata-page session label-id 0 limit)]) + (println "ID\tTime\tUnread\tSender\tSubject") + (for-each message-row messages))) + + (define (cmd-message-json args) + (let* ([parsed (split-opts args auth-known-options)] + [opts (car parsed)] + [message-id (opt opts "--id")]) + (unless message-id + (die 2 "message-json requires --id MESSAGE_ID")) + (let* ([session (authenticated-session-from-options opts)] + [message (proton-mail-get-message session message-id)]) + (println (json-object->string message))))) + + (define auth-known-options + '(("--username" . #t) + ("--base-url" . #t) + ("--password-env" . #t) + ("--prompt-pin" . #f) + ("--folder" . #t) + ("--limit" . #t) + ("--id" . #t))) (define (cmd-login args) (let* ([parsed (split-opts args @@ -209,8 +339,10 @@ [(string=? (car args) "version") (println version)] [(string=? (car args) "status") (print-status)] [(string=? (car args) "login") (cmd-login (cdr args))] - [(string=? (car args) "folders") (planned "folders")] - [(string=? (car args) "list") (planned "list")] + [(string=? (car args) "folders") + (cmd-folders (car (split-opts (cdr args) auth-known-options)))] + [(string=? (car args) "list") (cmd-list (cdr args))] + [(string=? (car args) "message-json") (cmd-message-json (cdr args))] [(string=? (car args) "show") (planned "show")] [else (die 2 (string-append "unknown command: " (car args)))]))) --- a/test/test-all.ss +++ b/test/test-all.ss @@ -28,6 +28,8 @@ (import (proton-bridge security)) (import (proton-bridge api http)) (import (proton-bridge api auth)) +(import (proton-bridge api mail)) +(import (proton-bridge api session)) (import (proton-bridge fido2)) (import (proton-bridge srp)) (import (only (yubikey fido2) make-fido2-assertion)) @@ -86,6 +88,19 @@ #t] [else (loop (cdr xs))])))) +(check "api auth headers include UID and bearer token" + (let ([headers (proton-api-auth-headers "uid-1" "token-1")]) + (let loop ([xs headers] [uid? #f] [auth? #f]) + (cond + [(null? xs) (and uid? auth?)] + [(and (pair? (car xs)) + (string=? (caar xs) "x-pm-uid")) + (loop (cdr xs) (string=? (caddar xs) "uid-1") auth?)] + [(and (pair? (car xs)) + (string=? (caar xs) "Authorization")) + (loop (cdr xs) uid? (string=? (caddar xs) "Bearer token-1"))] + [else (loop (cdr xs) uid? auth?)])))) + (define sample-auth-json "{\"publicKey\":{\"rpId\":\"proton.me\",\"challenge\":[1,2,3,4],\"allowCredentials\":[{\"type\":\"public-key\",\"id\":[9,8,7]}]}}") @@ -173,6 +188,30 @@ (and (proton-auth-fido2-required? sample-auth-after-srp) (not (proton-auth-totp-required? sample-auth-after-srp)))) +(check "session is created from auth without persistence" + (let ([session (proton-session-from-auth + default-proton-api-base-url + sample-auth-after-srp)]) + (and (string=? (proton-session-uid session) "uid-1") + (string=? (proton-session-access-token session) "access-1") + (string=? (proton-session-refresh-token session) "refresh-1")))) + +(define sample-folder + (let ([obj (string->json-object "{}")]) + (hashtable-set! obj "ID" "folder-1") + (hashtable-set! obj "Name" "Receipts") + (hashtable-set! obj "Path" '("Finance" "Receipts")) + obj)) + +(check "mail resolves system folder aliases" + (string=? (proton-mail-resolve-label-id '() "INBOX") "0")) + +(check "mail resolves custom folder by name and path" + (and (string=? (proton-mail-resolve-label-id (list sample-folder) "Receipts") + "folder-1") + (string=? (proton-mail-resolve-label-id (list sample-folder) "Finance/Receipts") + "folder-1"))) + (if (= failures 0) (begin (fprintf (current-error-port) "~%All tests passed.~%")