User authentication and session management for web applications
Make email an option type; add GitHub verified email endpoint
userinfo.email is now string option instead of string. For GitHub,
parse_userinfo intentionally returns None — the /user endpoint only
has the public email which is unverified. Add parse_github_emails to
extract the primary verified email from /user/emails (requires
user:email scope).
ocaml-auth's fetch_userinfo now calls /user/emails for GitHub to
populate the verified email. The type change forces all callers to
handle the missing-email case explicitly.
3 new tests for parse_github_emails. Existing tests updated.
+26
-6
+21
-2
lib/auth.ml
+21
-2
lib/auth.ml
···
302
302
if status >= 400 then err_userinfo_http status
303
303
else
304
304
let body = Requests.Response.text resp in
305
-
Oauth.parse_userinfo provider body
305
+
match Oauth.parse_userinfo provider body with
306
+
| Error _ as e -> e
307
+
| Ok ui -> (
308
+
match provider with
309
+
| Oauth.Github ->
310
+
(* Fetch verified primary email from /user/emails *)
311
+
let resp = Requests.get http Oauth.github_emails_url ~headers in
312
+
let email =
313
+
if Requests.Response.status_code resp >= 400 then None
314
+
else
315
+
match
316
+
Oauth.parse_github_emails (Requests.Response.text resp)
317
+
with
318
+
| Ok email -> Some email
319
+
| Error _ -> None
320
+
in
321
+
Ok { ui with email }
322
+
| _ -> Ok ui)
306
323
307
324
(* ── Routes ──────────────────────────────────────────────────────── *)
308
325
···
349
366
(* Find or create a user from OAuth userinfo, handling concurrent races. *)
350
367
let find_or_create_user store ~provider ~ui =
351
368
let provider_uid = ui.Oauth.uid in
352
-
let email = if ui.email <> "" then ui.email else ui.login ^ "@" ^ provider in
369
+
let email =
370
+
match ui.email with Some e -> e | None -> ui.login ^ "@" ^ provider
371
+
in
353
372
match Store.find_user_by_provider store ~provider ~provider_uid with
354
373
| Some u -> u
355
374
| None -> (
+5
-4
test/test_auth.ml
+5
-4
test/test_auth.ml
···
253
253
| Ok u ->
254
254
Alcotest.(check string) "uid" "12345" u.uid;
255
255
Alcotest.(check string) "login" "octocat" u.login;
256
-
Alcotest.(check string) "email" "octocat@github.com" u.email
256
+
Alcotest.(check (option string))
257
+
"email dropped (use /user/emails)" None u.email
257
258
258
259
let test_google_userinfo () =
259
260
let body =
···
263
264
| Error e -> Alcotest.fail e
264
265
| Ok u ->
265
266
Alcotest.(check string) "uid" "118234567890" u.uid;
266
-
Alcotest.(check string) "email" "user@gmail.com" u.email;
267
+
Alcotest.(check (option string)) "email" (Some "user@gmail.com") u.email;
267
268
Alcotest.(check string)
268
269
"avatar" "https://lh3.googleusercontent.com/photo.jpg" u.avatar_url
269
270
···
290
291
| Error e -> Alcotest.fail e
291
292
| Ok u ->
292
293
Alcotest.(check string) "uid" "999" u.uid;
293
-
Alcotest.(check string) "email empty" "" u.email
294
+
Alcotest.(check (option string)) "email absent" None u.email
294
295
295
296
let test_custom_provider_userinfo () =
296
297
let provider =
···
308
309
| Error e -> Alcotest.fail e
309
310
| Ok u ->
310
311
Alcotest.(check string) "uid" "EMP-42" u.uid;
311
-
Alcotest.(check string) "email" "a@corp.com" u.email
312
+
Alcotest.(check (option string)) "email" (Some "a@corp.com") u.email
312
313
313
314
let test_userinfo_rejects_garbage () =
314
315
match Oauth.parse_userinfo Github "not json at all" with