Add Proton HTTPS auth flow

ober

5436edcdd04296e417a8eccd5309da2d9a3e370c

diff --git a/Makefile b/Makefile
index dd37de3..eb53dc0 100644
--- a/Makefile
+++ b/Makefile
@@ -2,7 +2,9 @@ JERBOA_HOME ?= $(realpath $(CURDIR)/../jerboa)
 SCHEME      ?= $(JERBOA_HOME)/.chez/bin/scheme
 JERBOA_YUBIKEY_DIR ?= $(realpath $(CURDIR)/../jerboa-yubikey)
 JERBOA_MAIL_DIR ?= $(realpath $(CURDIR)/../jerboa-mail)
-LIBDIRS := $(CURDIR):$(JERBOA_YUBIKEY_DIR):$(JERBOA_MAIL_DIR):$(JERBOA_HOME)/lib
+JERBOA_HTTPS_DIR ?= $(realpath $(CURDIR)/../jerboa-https)
+JERBOA_SSL_DIR ?= $(realpath $(CURDIR)/../jerboa-ssl)
+LIBDIRS := $(CURDIR):$(JERBOA_YUBIKEY_DIR):$(JERBOA_MAIL_DIR):$(JERBOA_HTTPS_DIR)/lib:$(JERBOA_SSL_DIR)/lib:$(JERBOA_HOME)/lib
 NATIVE_MANIFEST := proton-bridge-native/Cargo.toml
 
 .PHONY: help native run test clean
@@ -22,16 +24,18 @@ help:
 	@echo "  SCHEME      = $(SCHEME)"
 	@echo "  JERBOA_YUBIKEY_DIR = $(JERBOA_YUBIKEY_DIR)"
 	@echo "  JERBOA_MAIL_DIR = $(JERBOA_MAIL_DIR)"
+	@echo "  JERBOA_HTTPS_DIR = $(JERBOA_HTTPS_DIR)"
+	@echo "  JERBOA_SSL_DIR = $(JERBOA_SSL_DIR)"
 
 native:
 	cargo build --manifest-path $(NATIVE_MANIFEST) --release
 
 run:
-	JERBOA_HOME=$(JERBOA_HOME) \
+	JERBOA_HOME=$(JERBOA_HOME) JERBOA_SSL_LIB=$(JERBOA_SSL_DIR) \
 		$(SCHEME) -q --libdirs $(LIBDIRS) --script main.ss -- $(ARGS)
 
 test: native
-	JERBOA_HOME=$(JERBOA_HOME) \
+	JERBOA_HOME=$(JERBOA_HOME) JERBOA_SSL_LIB=$(JERBOA_SSL_DIR) \
 		$(SCHEME) -q --libdirs $(LIBDIRS) --script test/test-all.ss
 
 clean:
diff --git a/README.md b/README.md
index 3b6eaa2..7036f2c 100644
--- a/README.md
+++ b/README.md
@@ -79,13 +79,19 @@ make native
 make test
 ```
 
-Current `login` support includes two offline probes:
+Current `login` support includes live auth and two offline probes:
 
 ```sh
+make run ARGS='login --username USER'
 make run ARGS='login --auth-info auth-info.json --username USER'
 make run ARGS='login --auth-options auth-options.json'
 ```
 
+The live login path performs `/auth/v4/info`, generates and submits the SRP
+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.
+
 `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.
diff --git a/plan.md b/plan.md
index 4bc2fce..38f1ea7 100644
--- a/plan.md
+++ b/plan.md
@@ -251,6 +251,10 @@ Done:
 - Native Proton SRP proof helper using Proton's MIT-licensed `proton-srp`.
 - Jerboa SRP wrapper that builds the `/auth/v4` request payload from a saved
   `/auth/v4/info` response.
+- Minimal HTTPS auth path for `/auth/v4/info`, `/auth/v4`, and
+  `/auth/v4/2fa`.
+- `login --username USER` performs SRP login, verifies `ServerProof`, and
+  submits FIDO2 when Proton requests it.
 
 Exit criteria:
 
@@ -330,7 +334,7 @@ Rejected default:
 
 Continue M2 in this repository:
 
-1. Add a minimal HTTPS Proton API module for `/auth/v4/info`, `/auth/v4`, and
-   `/auth/v4/2fa`.
-2. Verify `ServerProof` after `/auth/v4`.
-3. Submit the YubiKey-backed FIDO2 `Auth2FA` payload.
+1. Run a manual live login 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.
diff --git a/proton-bridge/api/auth.ss b/proton-bridge/api/auth.ss
new file mode 100644
index 0000000..276d85f
--- /dev/null
+++ b/proton-bridge/api/auth.ss
@@ -0,0 +1,111 @@
+#!chezscheme
+;;; (proton-bridge api auth) - Proton auth flow.
+
+(library (proton-bridge api auth)
+  (export
+    proton-auth-info
+    proton-auth-submit
+    proton-auth-submit-fido2
+    proton-auth-uid
+    proton-auth-access-token
+    proton-auth-refresh-token
+    proton-auth-fido2-required?
+    proton-auth-totp-required?)
+
+  (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?)
+          (only (std text json) string->json-object)
+          (proton-bridge api http)
+          (proton-bridge srp))
+
+  (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 (getopt opts kw default)
+    (let loop ([xs opts])
+      (cond
+        [(null? xs) default]
+        [(null? (cdr xs)) default]
+        [(eq? (car xs) kw) (cadr xs)]
+        [else (loop (cddr xs))])))
+
+  (def (proton-auth-info username . opts)
+    (proton-api-post-json
+      "/auth/v4/info"
+      (json-object "Username" username)
+      'base-url: (getopt opts 'base-url: default-proton-api-base-url)))
+
+  (def (proton-auth-submit auth-info username password . opts)
+    (let ([base-url (getopt opts 'base-url: default-proton-api-base-url)])
+      (call-with-values
+        (lambda () (proton-srp-auth-request-payload auth-info username password))
+        (lambda (proofs payload)
+          (let* ([auth (proton-api-post-json
+                         "/auth/v4"
+                         payload
+                         'base-url: base-url)]
+                 [server-proof (jref 'proton-auth-submit auth "ServerProof")])
+            (unless (proton-srp-server-proof-valid? proofs server-proof)
+              (error 'proton-auth-submit "unexpected Proton SRP server proof"))
+            (values proofs auth))))))
+
+  (def (proton-auth-submit-fido2 auth fido2-payload . opts)
+    (let* ([base-url (getopt opts 'base-url: default-proton-api-base-url)]
+           [payload (if (string? fido2-payload)
+                        (string->json-object fido2-payload)
+                        fido2-payload)])
+      (proton-api-post-json
+        "/auth/v4/2fa"
+        payload
+        'base-url: base-url
+        'uid: (proton-auth-uid auth)
+        'access-token: (proton-auth-access-token auth))))
+
+  (def (proton-auth-uid auth)
+    (jref 'proton-auth-uid auth "UID"))
+
+  (def (proton-auth-access-token auth)
+    (jref 'proton-auth-access-token auth "AccessToken"))
+
+  (def (proton-auth-refresh-token auth)
+    (jref 'proton-auth-refresh-token auth "RefreshToken"))
+
+  (def (twofa-enabled auth)
+    (let ([twofa (jmaybe auth "2FA")])
+      (and twofa (jmaybe twofa "Enabled"))))
+
+  (def (proton-auth-fido2-required? auth)
+    (let ([enabled (twofa-enabled auth)])
+      (or (equal? enabled 2)
+          (equal? enabled 3))))
+
+  (def (proton-auth-totp-required? auth)
+    (let ([enabled (twofa-enabled auth)])
+      (or (equal? enabled 1)
+          (equal? enabled 3))))
+
+  )
diff --git a/proton-bridge/api/http.ss b/proton-bridge/api/http.ss
new file mode 100644
index 0000000..6e05aec
--- /dev/null
+++ b/proton-bridge/api/http.ss
@@ -0,0 +1,124 @@
+#!chezscheme
+;;; (proton-bridge api http) - HTTPS transport for Proton API calls.
+
+(library (proton-bridge api http)
+  (export
+    default-proton-api-base-url
+    default-proton-app-version
+    proton-api-url
+    proton-api-default-headers
+    proton-api-auth-headers
+    proton-api-post-json)
+
+  (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?)
+          (only (std text json) json-object->string string->json-object)
+          (jerboa-https))
+
+  (define default-proton-api-base-url "https://mail.proton.me/api")
+  (define default-proton-app-version "jerboa-proton-bridge_0.1.0")
+
+  (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 (api-string-prefix? prefix s)
+    (let ([n (string-length prefix)])
+      (and (>= (string-length s) n)
+           (string=? prefix (substring s 0 n)))))
+
+  (def (api-string-suffix? suffix s)
+    (let ([n (string-length suffix)]
+          [m (string-length s)])
+      (and (>= m n)
+           (string=? suffix (substring s (- m n) m)))))
+
+  (def (trim-trailing-slash s)
+    (if (and (> (string-length s) 0) (api-string-suffix? "/" s))
+        (substring s 0 (- (string-length s) 1))
+        s))
+
+  (def (proton-api-url base-url path)
+    (let ([base (trim-trailing-slash base-url)])
+      (if (api-string-prefix? "/" path)
+          (string-append base path)
+          (string-append base "/" path))))
+
+  (def (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)))
+
+  (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)))))
+
+  (def (getopt opts kw default)
+    (let loop ([xs opts])
+      (cond
+        [(null? xs) default]
+        [(null? (cdr xs)) default]
+        [(eq? (car xs) kw) (cadr xs)]
+        [else (loop (cddr xs))])))
+
+  (def (json-field obj key default)
+    (and (hash-table? obj) (hash-ref obj key default)))
+
+  (def (parse-json-or-empty text)
+    (if (= (string-length text) 0)
+        (json-object)
+        (string->json-object text)))
+
+  (def (response-error-message status text)
+    (let ([parsed (guard (e [#t #f]) (parse-json-or-empty text))])
+      (if parsed
+          (let ([message (or (json-field parsed "Message" #f)
+                             (json-field parsed "Error" #f)
+                             "Proton API request failed")])
+            (format "Proton API HTTP ~a: ~a" status message))
+          (format "Proton API HTTP ~a" status))))
+
+  (def (success-status? status)
+    (and (>= status 200) (< status 300)))
+
+  (def (proton-api-post-json 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))]
+           [url (proton-api-url base-url path)]
+           [body (json-object->string payload)]
+           [req (http-post url
+                  'headers: headers
+                  'params: #f
+                  'data: (string->utf8 body))]
+           [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)))))
+
+  )
diff --git a/proton-bridge/cli.ss b/proton-bridge/cli.ss
index 0c45403..a3b61bb 100644
--- a/proton-bridge/cli.ss
+++ b/proton-bridge/cli.ss
@@ -15,6 +15,8 @@
                   make-date make-time)
           (only (std text json) string->json-object)
           (proton-bridge security)
+          (proton-bridge api auth)
+          (proton-bridge api http)
           (proton-bridge fido2)
           (proton-bridge srp)
           (only (yubikey fido2) fido2-assertion-credential-id))
@@ -134,11 +136,42 @@
             (println (string-append "expected ServerProof: "
                                     (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)))])))))))
+
   (define (cmd-login args)
     (let* ([parsed (split-opts args
                     '(("--auth-options" . #t)
                       ("--auth-info" . #t)
                       ("--username" . #t)
+                      ("--base-url" . #t)
                       ("--password-env" . #t)
                       ("--prompt-pin" . #f)))]
            [opts (car parsed)]
@@ -163,8 +196,7 @@
                                            (fido2-assertion-credential-id assertion)))))
                (println payload-json))))]
         [else
-        (die 2
-             "native HTTP login is not implemented yet; pass --auth-info FILE for an SRP request body or --auth-options FILE for a FIDO2 Auth2FA payload")])))
+         (cmd-login-live opts)])))
 
   (define (run-cli raw-args)
     (let ([args (strip-script-separator raw-args)])
diff --git a/test/test-all.ss b/test/test-all.ss
index f9b545a..4bcaf1f 100644
--- a/test/test-all.ss
+++ b/test/test-all.ss
@@ -26,6 +26,8 @@
 
 (import (proton-bridge cli))
 (import (proton-bridge security))
+(import (proton-bridge api http))
+(import (proton-bridge api auth))
 (import (proton-bridge fido2))
 (import (proton-bridge srp))
 (import (only (yubikey fido2) make-fido2-assertion))
@@ -70,6 +72,20 @@
 (check "default policy requires YubiKey"
        (policy-requires-yubikey? (default-security-policy)))
 
+(check "api URL joins base and path"
+       (string=? (proton-api-url "https://mail.proton.me/api/" "/auth/v4/info")
+                 "https://mail.proton.me/api/auth/v4/info"))
+
+(check "api default headers include app version"
+       (let ([headers (proton-api-default-headers)])
+         (let loop ([xs headers])
+           (cond
+             [(null? xs) #f]
+             [(and (pair? (car xs))
+                   (string=? (caar xs) "x-pm-appversion"))
+              #t]
+             [else (loop (cdr xs))]))))
+
 (define sample-auth-json
   "{\"publicKey\":{\"rpId\":\"proton.me\",\"challenge\":[1,2,3,4],\"allowCredentials\":[{\"type\":\"public-key\",\"id\":[9,8,7]}]}}")
 
@@ -144,6 +160,19 @@
                   (= (string-length (hashtable-ref payload "ClientEphemeral" "")) 344)
                   (= (string-length (hashtable-ref payload "ClientProof" "")) 344))))))
 
+(define sample-auth-after-srp
+  (string->json-object
+    "{\"UID\":\"uid-1\",\"AccessToken\":\"access-1\",\"RefreshToken\":\"refresh-1\",\"ServerProof\":\"proof\",\"2FA\":{\"Enabled\":2,\"FIDO2\":{\"AuthenticationOptions\":{\"publicKey\":{\"rpId\":\"proton.me\",\"challenge\":[1],\"allowCredentials\":[{\"id\":[2]}]}}}}}"))
+
+(check "auth accessors read tokens without printing them"
+       (and (string=? (proton-auth-uid sample-auth-after-srp) "uid-1")
+            (string=? (proton-auth-access-token sample-auth-after-srp) "access-1")
+            (string=? (proton-auth-refresh-token sample-auth-after-srp) "refresh-1")))
+
+(check "auth detects FIDO2 requirement"
+       (and (proton-auth-fido2-required? sample-auth-after-srp)
+            (not (proton-auth-totp-required? sample-auth-after-srp))))
+
 (if (= failures 0)
     (begin
       (fprintf (current-error-port) "~%All tests passed.~%")