User authentication and session management for web applications
Track email_verified in userinfo; require verified email for sign-in
Add email_verified:bool to Oauth.userinfo. Google OIDC sets it from
the email_verified field; GitHub sets it when /user/emails returns a
verified primary; GitLab and custom default to false. The encoder now
faithfully round-trips the verification status.
ocaml-auth now requires email_verified=true to create a user account.
Sign-in is rejected with a clear error if no verified email is
available, instead of fabricating a fake login@provider address.
+57
-35
+40
-31
lib/auth.ml
+40
-31
lib/auth.ml
···
318
318
| Ok email -> Some email
319
319
| Error _ -> None
320
320
in
321
-
Ok { ui with email }
321
+
Ok { ui with email; email_verified = Option.is_some email }
322
322
| _ -> Ok ui)
323
323
324
324
(* ── Routes ──────────────────────────────────────────────────────── *)
···
363
363
let resp = Requests.post cfg.http token_url ~body ~headers in
364
364
Oauth.parse_token_response (Requests.Response.text resp)
365
365
366
-
(* Find or create a user from OAuth userinfo, handling concurrent races. *)
366
+
(* Find or create a user from OAuth userinfo, handling concurrent races.
367
+
Requires a verified email — returns Error if the provider did not supply
368
+
one or if email_verified is false. *)
367
369
let find_or_create_user store ~provider ~ui =
368
370
let provider_uid = ui.Oauth.uid in
369
-
let email =
370
-
match ui.email with Some e -> e | None -> ui.login ^ "@" ^ provider
371
-
in
372
-
match Store.find_user_by_provider store ~provider ~provider_uid with
373
-
| Some u -> u
374
-
| None -> (
375
-
try
376
-
Store.create_user store ~email ~name:ui.name ~avatar_url:ui.avatar_url
377
-
~provider ~provider_uid
378
-
with Sqlite.Unique_violation _ -> (
379
-
match Store.find_user_by_provider store ~provider ~provider_uid with
380
-
| Some u -> u
381
-
| None -> failwith "BUG: unique violation but identity not found"))
371
+
match (ui.Oauth.email, ui.email_verified) with
372
+
| None, _ | _, false ->
373
+
Error "sign-in requires a verified email address from the provider"
374
+
| Some email, true -> (
375
+
match Store.find_user_by_provider store ~provider ~provider_uid with
376
+
| Some u -> Ok u
377
+
| None -> (
378
+
try
379
+
Ok
380
+
(Store.create_user store ~email ~name:ui.name
381
+
~avatar_url:ui.avatar_url ~provider ~provider_uid)
382
+
with Sqlite.Unique_violation _ -> (
383
+
match Store.find_user_by_provider store ~provider ~provider_uid with
384
+
| Some u -> Ok u
385
+
| None -> failwith "BUG: unique violation but identity not found")))
382
386
383
387
(** GET /auth/callback — exchange code, create/find user, set session *)
384
388
let callback_route (cfg : config) store (req : Respond.get_request) =
···
408
412
| Error e ->
409
413
Log.err (fun m -> m "callback: user fetch failed: %s" e);
410
414
Respond.Response.internal_server_error "User fetch failed"
411
-
| Ok ui ->
415
+
| Ok ui -> (
412
416
let provider =
413
417
Oauth.provider_name cfg.session.oauth_provider
414
418
in
415
-
let user = find_or_create_user store ~provider ~ui in
416
-
Store.delete_user_sessions store
417
-
~secret:cfg.session.cookie_secret ~user_id:user.id;
418
-
let session =
419
-
Store.create_session store ~secret:cfg.session.cookie_secret
420
-
~user_id:user.id
421
-
in
422
-
Log.info (fun m -> m "callback: signed in %a" pp_user user);
423
-
let cookie =
424
-
set_cookie_header ~base_url:cfg.session.base_url
425
-
session.token
426
-
in
427
-
Respond.Response.v ~status:302
428
-
~headers:[ ("Location", "/"); cookie ]
429
-
~content_type:"text/plain" "")))
419
+
match find_or_create_user store ~provider ~ui with
420
+
| Error e ->
421
+
Log.warn (fun m -> m "callback: %s" e);
422
+
Respond.Response.bad_request e
423
+
| Ok user ->
424
+
Store.delete_user_sessions store
425
+
~secret:cfg.session.cookie_secret ~user_id:user.id;
426
+
let session =
427
+
Store.create_session store
428
+
~secret:cfg.session.cookie_secret ~user_id:user.id
429
+
in
430
+
Log.info (fun m ->
431
+
m "callback: signed in %a" pp_user user);
432
+
let cookie =
433
+
set_cookie_header ~base_url:cfg.session.base_url
434
+
session.token
435
+
in
436
+
Respond.Response.v ~status:302
437
+
~headers:[ ("Location", "/"); cookie ]
438
+
~content_type:"text/plain" ""))))
430
439
431
440
(** POST /auth/signout — revoke session server-side, clear cookie, redirect *)
432
441
let signout_route (_cfg : session_config) store (req : Respond.post_request) =
+2
-1
lib/auth.mli
+2
-1
lib/auth.mli
···
125
125
avatar_url : string;
126
126
created_at : float; (** Unix timestamp. *)
127
127
}
128
-
(** A user account. The [id] is the SQLite rowid, stable across sessions. *)
128
+
(** A user account. The [id] is the SQLite rowid. [email] is always a verified
129
+
email address — sign-in is rejected if the provider cannot supply one. *)
129
130
130
131
val pp_user : user Fmt.t
131
132
(** [pp_user] formats a user as [user(<id>, <email>, <name>)]. *)
+15
-3
test/test_auth.ml
+15
-3
test/test_auth.ml
···
266
266
| Ok u ->
267
267
Alcotest.(check string) "uid" "118234567890" u.uid;
268
268
Alcotest.(check (option string)) "email" (Some "user@gmail.com") u.email;
269
+
Alcotest.(check bool) "email_verified" true u.email_verified;
269
270
Alcotest.(check string)
270
271
"avatar" "https://lh3.googleusercontent.com/photo.jpg" u.avatar_url);
271
-
(* Without email_verified — email is dropped *)
272
+
(* Without email_verified — email is dropped, verified is false *)
272
273
let body_unverified =
273
274
{|{"sub":"118234567890","email":"user@gmail.com","name":"Test User","picture":"https://lh3.googleusercontent.com/photo.jpg"}|}
274
275
in
275
-
match Oauth.parse_userinfo Google body_unverified with
276
+
(match Oauth.parse_userinfo Google body_unverified with
276
277
| Error e -> Alcotest.fail e
277
278
| Ok u ->
278
-
Alcotest.(check (option string)) "unverified email dropped" None u.email
279
+
Alcotest.(check (option string)) "unverified email dropped" None u.email;
280
+
Alcotest.(check bool) "email_verified false" false u.email_verified);
281
+
(* With email_verified: false — email is dropped *)
282
+
let body_false =
283
+
{|{"sub":"118234567890","email":"user@gmail.com","email_verified":false,"name":"Test User","picture":"https://lh3.googleusercontent.com/photo.jpg"}|}
284
+
in
285
+
match Oauth.parse_userinfo Google body_false with
286
+
| Error e -> Alcotest.fail e
287
+
| Ok u ->
288
+
Alcotest.(check (option string))
289
+
"false-verified email dropped" None u.email;
290
+
Alcotest.(check bool) "email_verified false" false u.email_verified
279
291
280
292
let test_gitlab_userinfo () =
281
293
let body =