User authentication and session management for web applications
Linter fixes: auth refactor, github-oauth merge, respond cleanup
+402
-251
+20
-50
lib/auth.ml
+20
-50
lib/auth.ml
···
178
178
| None -> None
179
179
| Some session -> Store.find_user store session.user_id)
180
180
181
-
(* ── Provider user profile fetch ─────────────────────────────────── *)
182
-
183
-
type provider_user = {
184
-
uid : string; (* provider-specific unique ID *)
185
-
login : string;
186
-
email : string;
187
-
name : string;
188
-
avatar_url : string;
189
-
}
181
+
(* ── Userinfo fetch ──────────────────────────────────────────────── *)
190
182
191
-
(* Generic userinfo: providers return different field names but all have
192
-
some form of id, name, email, avatar. We try common field names. *)
193
-
let provider_user_jsont =
194
-
Jsont.Object.map ~kind:"provider_user" (fun id login email name avatar_url ->
195
-
{
196
-
uid = (match id with i when i > 0 -> string_of_int i | _ -> login);
197
-
login;
198
-
email;
199
-
name;
200
-
avatar_url;
201
-
})
202
-
|> Jsont.Object.mem "id" Jsont.int ~dec_absent:0 ~enc:(fun _ -> 0)
203
-
|> Jsont.Object.mem "login" Jsont.string ~dec_absent:""
204
-
~enc:(fun (u : provider_user) -> u.login)
205
-
|> Jsont.Object.mem "email" Jsont.string ~dec_absent:""
206
-
~enc:(fun (u : provider_user) -> u.email)
207
-
|> Jsont.Object.mem "name" Jsont.string ~dec_absent:""
208
-
~enc:(fun (u : provider_user) -> u.name)
209
-
|> Jsont.Object.mem "avatar_url" Jsont.string ~dec_absent:""
210
-
~enc:(fun (u : provider_user) -> u.avatar_url)
211
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
212
-
213
-
let fetch_provider_user http ~userinfo_url ~access_token =
183
+
let fetch_userinfo http ~provider ~access_token =
214
184
let headers =
215
185
Headers.empty
216
186
|> Headers.set `Authorization (Fmt.str "Bearer %s" access_token)
217
187
|> Headers.set `Accept "application/json"
218
188
in
219
-
let resp = Requests.get http userinfo_url ~headers in
220
-
let body = Requests.Response.text resp in
221
-
match Jsont_bytesrw.decode_string provider_user_jsont body with
222
-
| Ok user -> Ok user
223
-
| Error e -> Error e
189
+
let url = Oauth.userinfo_url provider in
190
+
let resp = Requests.get http url ~headers in
191
+
let status = Requests.Response.status_code resp in
192
+
if status >= 400 then
193
+
Error (Fmt.str "userinfo endpoint returned HTTP %d" status)
194
+
else
195
+
let body = Requests.Response.text resp in
196
+
Oauth.parse_userinfo provider body
224
197
225
198
(* ── Routes ──────────────────────────────────────────────────────── *)
226
199
···
230
203
(* Sign the state for CSRF verification on callback *)
231
204
let signed_state = Csrf.sign_state ~secret:config.cookie_secret state in
232
205
let redirect_uri = config.base_url ^ "/auth/callback" in
233
-
let scope =
234
-
if config.oauth_provider.name = "github" then [ "user:email" ] else []
235
-
in
206
+
let scope = Oauth.default_scope config.oauth_provider in
236
207
let url =
237
208
Oauth.authorization_url config.oauth_provider ~client_id:config.client_id
238
209
~redirect_uri ~state:signed_state ~scope
···
260
231
Oauth.exchange_form_body ~client_id:config.client_id
261
232
~client_secret:config.client_secret ~code ~redirect_uri
262
233
in
263
-
let token_url = config.oauth_provider.token_url in
234
+
let token_url = Oauth.token_url config.oauth_provider in
264
235
let headers =
265
236
Headers.of_list
266
237
[
···
280
251
| Ok token_resp -> (
281
252
(* Fetch user profile from provider *)
282
253
match
283
-
fetch_provider_user config.http
284
-
~userinfo_url:config.oauth_provider.userinfo_url
254
+
fetch_userinfo config.http ~provider:config.oauth_provider
285
255
~access_token:token_resp.access_token
286
256
with
287
257
| Error e ->
288
258
Log.err (fun m -> m "callback: user fetch failed: %s" e);
289
259
Respond.Response.internal_server_error "User fetch failed"
290
-
| Ok pu ->
291
-
let provider = config.oauth_provider.name in
292
-
let provider_uid = pu.uid in
260
+
| Ok (ui : Oauth.userinfo) ->
261
+
let provider = Oauth.provider_name config.oauth_provider in
262
+
let provider_uid = ui.uid in
293
263
let email =
294
-
if pu.email <> "" then pu.email
295
-
else pu.login ^ "@" ^ provider
264
+
if ui.email <> "" then ui.email
265
+
else ui.login ^ "@" ^ provider
296
266
in
297
267
(* Find or create user *)
298
268
let user =
···
301
271
with
302
272
| Some u -> u
303
273
| None ->
304
-
Store.create_user store ~email ~name:pu.name
305
-
~avatar_url:pu.avatar_url ~provider ~provider_uid
274
+
Store.create_user store ~email ~name:ui.name
275
+
~avatar_url:ui.avatar_url ~provider ~provider_uid
306
276
~access_token:token_resp.access_token
307
277
in
308
278
(* Create session *)
+82
-45
lib/auth.mli
+82
-45
lib/auth.mli
···
1
-
(** User authentication and session management for web applications.
1
+
(** User authentication and session management.
2
2
3
-
Provides OAuth-based authentication, user management, and cookie-based
4
-
session handling. Ties together {!Oauth}, {!Sqlite}, and {!Csrf} into a
5
-
reusable auth flow.
3
+
{b Auth} provides OAuth-based user authentication with server-side sessions.
4
+
It handles the full sign-in lifecycle: redirect to provider, exchange
5
+
authorization code, create or find user, issue session cookie.
6
6
7
-
{2 Quick Start}
7
+
Sessions are stored server-side in SQLite for revocability. Cookies are
8
+
{e HttpOnly}, {e SameSite=Lax}, and {e Secure} (when base URL is HTTPS).
9
+
CSRF protection on the OAuth callback uses signed state tokens via {!Csrf}.
10
+
11
+
{2 Quick start}
8
12
9
13
{[
10
-
let store = Auth.Store.v ~sw db_path in
11
-
let config =
12
-
Auth.config ~oauth_provider:Oauth.Github.provider
13
-
~client_id:"xxx" ~client_secret:"yyy"
14
-
~base_url:"https://app.com" ~cookie_secret:"secret"
14
+
Eio_main.run @@ fun env ->
15
+
Eio.Switch.run @@ fun sw ->
16
+
let fs = Eio.Stdenv.fs env in
17
+
let http = Requests.v ~sw env in
18
+
let store = Auth.Store.v ~sw Eio.Path.(fs / "data" / "auth.db") in
19
+
let cfg =
20
+
Auth.config ~oauth_provider:Oauth.Github ~client_id:"Iv1.abc"
21
+
~client_secret:"secret" ~base_url:"https://app.com"
22
+
~cookie_secret:"32-char-min" ~http
15
23
in
16
-
let routes = Auth.routes config store in
17
-
(* Add to your Respond routes *)
18
-
]} *)
24
+
let routes = Auth.routes cfg store in
25
+
Respond.run ~net:(Eio.Stdenv.net env) ~port:8080
26
+
~root:Eio.Path.(fs / "static")
27
+
routes
28
+
]}
29
+
30
+
{2 Session lifecycle}
31
+
32
+
+ User visits [GET /auth/signin].
33
+
+ Server redirects to the OAuth provider with a signed state parameter.
34
+
+ Provider redirects back to [GET /auth/callback?code=...&state=...].
35
+
+ Server verifies state (CSRF), exchanges code for access token, fetches
36
+
user profile, creates or finds the user, issues a session cookie, and
37
+
redirects to [/].
38
+
+ On [POST /auth/signout], the server-side session is revoked and the cookie
39
+
is cleared. *)
19
40
20
41
open Http
21
42
22
-
(** {1 Configuration} *)
43
+
(** {1:config Configuration} *)
23
44
24
45
type config
25
-
(** Auth configuration: OAuth provider, client credentials, URLs, secrets. *)
46
+
(** Authentication configuration. *)
26
47
27
48
val config :
28
49
oauth_provider:Oauth.provider ->
···
33
54
http:Requests.t ->
34
55
config
35
56
(** [config ~oauth_provider ~client_id ~client_secret ~base_url ~cookie_secret
36
-
~http] creates auth configuration.
57
+
~http] is an auth configuration.
37
58
38
-
@param base_url Public base URL (e.g. [https://run.space])
39
-
@param cookie_secret Secret for signing session cookies (32+ chars) *)
59
+
- [base_url] is the public origin (e.g. [https://run.space]). It determines
60
+
the callback URL and whether cookies are marked {e Secure}.
61
+
- [cookie_secret] is used to sign CSRF state tokens. Must be at least 32
62
+
characters. *)
40
63
41
-
(** {1 Users} *)
64
+
(** {1:user Users} *)
42
65
43
66
type user = {
44
67
id : int;
45
68
email : string;
46
69
name : string;
47
70
avatar_url : string;
48
-
created_at : float;
71
+
created_at : float; (** Unix timestamp. *)
49
72
}
50
-
(** A user account. *)
73
+
(** A user account. The [id] is the SQLite rowid, stable across sessions. *)
51
74
52
75
val pp_user : user Fmt.t
76
+
(** [pp_user] formats a user as [user(<id>, <email>, <name>)]. *)
53
77
54
-
(** {1 Sessions} *)
78
+
(** {1:session Sessions} *)
55
79
56
-
type session = { token : string; user_id : int; expires_at : float }
57
-
(** A server-side session. *)
80
+
type session = {
81
+
token : string; (** 64-char hex, cryptographically random. *)
82
+
user_id : int;
83
+
expires_at : float; (** Unix timestamp. *)
84
+
}
85
+
(** A server-side session. Tokens are stored in the cookie as [sid=<token>].
86
+
Default lifetime is 30 days. *)
58
87
59
-
(** {1 Store} *)
88
+
(** {1:store Store} *)
60
89
61
90
module Store : sig
62
91
type t
63
-
(** User and session database. *)
92
+
(** User and session database backed by {!Sqlite}. Creates [users] and
93
+
[oauth_identities] tables on first open, plus a [sessions] KV table. *)
64
94
65
95
val v : sw:Eio.Switch.t -> Eio.Fs.dir_ty Eio.Path.t -> t
66
96
(** [v ~sw path] opens or creates the auth database at [path]. *)
67
97
68
-
val find_user_by_provider :
69
-
t -> provider:string -> provider_uid:string -> user option
70
-
(** Find a user by OAuth provider identity. *)
98
+
(** {2 Users} *)
71
99
72
100
val find_user : t -> int -> user option
73
-
(** Find a user by ID. *)
101
+
(** [find_user store id] is the user with rowid [id], or [None]. *)
102
+
103
+
val find_user_by_provider :
104
+
t -> provider:string -> provider_uid:string -> user option
105
+
(** [find_user_by_provider store ~provider ~provider_uid] is the user linked
106
+
to the given OAuth identity, or [None]. *)
74
107
75
108
val create_user :
76
109
t ->
···
81
114
provider_uid:string ->
82
115
access_token:string ->
83
116
user
84
-
(** Create a user and linked OAuth identity. Returns the new user. *)
117
+
(** [create_user store ~email ~name ~avatar_url ~provider ~provider_uid
118
+
~access_token] inserts a user and an associated OAuth identity row.
119
+
Returns the new user with its assigned [id]. *)
120
+
121
+
(** {2 Sessions} *)
85
122
86
123
val create_session : t -> user_id:int -> session
87
-
(** Create a session for a user. Returns the session with a random token.
88
-
Sessions expire after 30 days. *)
124
+
(** [create_session store ~user_id] creates a session with a cryptographically
125
+
random token. Expires after 30 days. *)
89
126
90
127
val find_session : t -> string -> session option
91
-
(** [find_session store token] looks up a session by token. Returns [None] if
92
-
not found or expired. *)
128
+
(** [find_session store token] is the session for [token], or [None] if the
129
+
token is unknown or expired. Expired sessions are deleted on lookup. *)
93
130
94
131
val delete_session : t -> string -> unit
95
-
(** [delete_session store token] revokes a session. *)
132
+
(** [delete_session store token] revokes [token]. No-op if absent. *)
96
133
end
97
134
98
-
(** {1 Middleware} *)
135
+
(** {1:middleware Middleware} *)
99
136
100
137
val current_user : config -> Store.t -> Respond.post_request -> user option
101
-
(** [current_user config store req] extracts the session cookie from the request
102
-
and returns the authenticated user, or [None]. *)
138
+
(** [current_user cfg store req] extracts the [sid] cookie from [req], validates
139
+
the session, and returns the authenticated user or [None]. *)
103
140
104
141
val current_user_from_params :
105
142
config -> Store.t -> Respond.params -> Headers.t -> user option
106
-
(** Same as {!current_user} but takes params and headers directly (for GET
107
-
routes that need to check auth via cookie header). *)
143
+
(** Same as {!current_user} but takes raw [params] and [headers]. Useful in GET
144
+
handlers where only query parameters are available. *)
108
145
109
-
(** {1 Routes} *)
146
+
(** {1:routes Routes} *)
110
147
111
148
val routes : config -> Store.t -> Respond.route list
112
-
(** [routes config store] returns auth routes:
149
+
(** [routes cfg store] is
113
150
- [GET /auth/signin] — redirect to OAuth provider
114
-
- [GET /auth/callback] — handle OAuth callback, create session
115
-
- [GET /auth/signout] — clear session, redirect to [/] *)
151
+
- [GET /auth/callback] — handle provider callback, create session
152
+
- [POST /auth/signout] — revoke session, clear cookie, redirect to [/] *)
+1
-2
test/dune
+1
-2
test/dune
+296
-154
test/test_auth.ml
+296
-154
test/test_auth.ml
···
1
-
open Eio.Std
2
-
module Headers = Requests.Headers
3
-
module Response = Requests.Response
1
+
(** Tests for {!Auth}. *)
4
2
5
-
let contains str ~substring =
6
-
let len = String.length substring in
7
-
let rec go i =
8
-
if i + len > String.length str then false
9
-
else if String.sub str i len = substring then true
10
-
else go (i + 1)
11
-
in
12
-
go 0
3
+
open Http
13
4
14
-
let first_existing paths =
15
-
match List.find_opt Sys.file_exists paths with
16
-
| Some path -> path
17
-
| None ->
18
-
Alcotest.fail
19
-
(Fmt.str "missing test fixture, looked for one of: %s"
20
-
(String.concat ", " paths))
21
-
22
-
let read_file paths =
23
-
In_channel.with_open_bin (first_existing paths) In_channel.input_all
24
-
25
-
let next_port =
26
-
let port = ref 38080 in
27
-
fun () ->
28
-
let v = !port in
29
-
incr port;
30
-
v
31
-
32
-
let base_url port = Fmt.str "http://127.0.0.1:%d" port
5
+
(* ── Helpers ───────────────────────────────────────────────────── *)
33
6
34
7
let temp_db_path env name =
35
8
let cwd = Eio.Stdenv.cwd env in
···
37
10
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dir with Eio.Io _ -> ());
38
11
Eio.Path.(dir / Fmt.str "%s_%d.db" name (Random.int 1_000_000))
39
12
40
-
let start_server env ~sw ~port routes =
41
-
let root = Eio.Stdenv.cwd env in
42
-
Eio.Fiber.fork_daemon ~sw (fun () ->
43
-
Respond.run ~net:env#net ~port ~root routes);
44
-
Eio.Time.sleep env#clock 0.05
13
+
let with_store f =
14
+
Eio_main.run @@ fun env ->
15
+
Eio.Switch.run @@ fun sw ->
16
+
f env sw (Auth.Store.v ~sw (temp_db_path env "test"))
45
17
46
-
let requests_timeout = Requests.Timeout.v ~connect:0.2 ~read:0.2 ~total:0.3 ()
18
+
(* ── Store: invalid database ───────────────────────────────────── *)
47
19
48
-
let test_store_v_rejects_invalid_database () =
20
+
let test_store_rejects_invalid_database () =
49
21
Eio_main.run @@ fun env ->
50
22
let path = temp_db_path env "invalid" in
51
23
let garbage = "not a sqlite database" in
···
54
26
(try Eio.Switch.run @@ fun sw -> ignore (Auth.Store.v ~sw path)
55
27
with _ -> raised := true);
56
28
Alcotest.(check bool) "invalid db raises" true !raised;
57
-
Alcotest.(check string) "invalid db is preserved" garbage (Eio.Path.load path)
29
+
Alcotest.(check string) "file preserved" garbage (Eio.Path.load path)
30
+
31
+
(* ── Store: user CRUD ──────────────────────────────────────────── *)
32
+
33
+
let test_create_and_find_user () =
34
+
with_store @@ fun _env _sw store ->
35
+
let user =
36
+
Auth.Store.create_user store ~email:"alice@example.com" ~name:"Alice"
37
+
~avatar_url:"https://example.com/alice.png" ~provider:"github"
38
+
~provider_uid:"12345" ~access_token:"gho_test"
39
+
in
40
+
Alcotest.(check string) "email" "alice@example.com" user.email;
41
+
Alcotest.(check string) "name" "Alice" user.name;
42
+
Alcotest.(check bool) "id > 0" true (user.id > 0);
43
+
let found = Auth.Store.find_user store user.id in
44
+
Alcotest.(check bool) "found" true (Option.is_some found);
45
+
Alcotest.(check int) "same id" user.id (Option.get found).id;
46
+
Alcotest.(check string)
47
+
"same email" "alice@example.com" (Option.get found).email
58
48
59
-
let test_signout_revokes_server_session () =
60
-
Eio_main.run @@ fun env ->
61
-
Eio.Switch.run @@ fun sw ->
62
-
let port = next_port () in
63
-
let http =
64
-
Requests.v ~sw ~follow_redirects:false ~timeout:requests_timeout env
49
+
let test_find_user_by_provider () =
50
+
with_store @@ fun _env _sw store ->
51
+
let user =
52
+
Auth.Store.create_user store ~email:"bob@example.com" ~name:"Bob"
53
+
~avatar_url:"" ~provider:"github" ~provider_uid:"67890"
54
+
~access_token:"gho_bob"
55
+
in
56
+
let found =
57
+
Auth.Store.find_user_by_provider store ~provider:"github"
58
+
~provider_uid:"67890"
59
+
in
60
+
Alcotest.(check bool) "found" true (Option.is_some found);
61
+
Alcotest.(check int) "same id" user.id (Option.get found).id
62
+
63
+
let test_wrong_provider_returns_none () =
64
+
with_store @@ fun _env _sw store ->
65
+
let _user =
66
+
Auth.Store.create_user store ~email:"carol@example.com" ~name:"Carol"
67
+
~avatar_url:"" ~provider:"github" ~provider_uid:"11111"
68
+
~access_token:"tok"
69
+
in
70
+
Alcotest.(check bool)
71
+
"wrong provider" true
72
+
(Option.is_none
73
+
(Auth.Store.find_user_by_provider store ~provider:"google"
74
+
~provider_uid:"11111"));
75
+
Alcotest.(check bool)
76
+
"wrong uid" true
77
+
(Option.is_none
78
+
(Auth.Store.find_user_by_provider store ~provider:"github"
79
+
~provider_uid:"99999"))
80
+
81
+
let test_nonexistent_user () =
82
+
with_store @@ fun _env _sw store ->
83
+
Alcotest.(check bool)
84
+
"not found" true
85
+
(Option.is_none (Auth.Store.find_user store 999999))
86
+
87
+
let test_multiple_users () =
88
+
with_store @@ fun _env _sw store ->
89
+
let u1 =
90
+
Auth.Store.create_user store ~email:"a@x.com" ~name:"A" ~avatar_url:""
91
+
~provider:"github" ~provider_uid:"1" ~access_token:"t1"
65
92
in
66
-
let store = Auth.Store.v ~sw (temp_db_path env "signout") in
67
-
let config =
68
-
Auth.config ~oauth_provider:Oauth.Github.provider ~client_id:"client"
69
-
~client_secret:"secret" ~base_url:(base_url port)
70
-
~cookie_secret:"cookie-secret" ~http
93
+
let u2 =
94
+
Auth.Store.create_user store ~email:"b@x.com" ~name:"B" ~avatar_url:""
95
+
~provider:"github" ~provider_uid:"2" ~access_token:"t2"
71
96
in
97
+
Alcotest.(check bool) "different ids" true (u1.id <> u2.id);
98
+
Alcotest.(check string)
99
+
"u1" "a@x.com" (Option.get (Auth.Store.find_user store u1.id)).email;
100
+
Alcotest.(check string)
101
+
"u2" "b@x.com" (Option.get (Auth.Store.find_user store u2.id)).email
102
+
103
+
(* ── Store: sessions ───────────────────────────────────────────── *)
104
+
105
+
let test_create_and_find_session () =
106
+
with_store @@ fun _env _sw store ->
72
107
let user =
73
-
Auth.Store.create_user store ~email:"user@example.com" ~name:"User"
74
-
~avatar_url:"https://example.com/avatar.png" ~provider:"github"
75
-
~provider_uid:"42" ~access_token:"token"
108
+
Auth.Store.create_user store ~email:"eve@x.com" ~name:"Eve" ~avatar_url:""
109
+
~provider:"github" ~provider_uid:"33333" ~access_token:"tok"
76
110
in
77
111
let session = Auth.Store.create_session store ~user_id:user.id in
78
-
start_server env ~sw ~port (Auth.routes config store);
79
-
let headers =
80
-
Headers.of_list [ ("Cookie", Fmt.str "sid=%s" session.token) ]
112
+
Alcotest.(check int) "user_id" user.id session.user_id;
113
+
Alcotest.(check bool) "64 hex chars" true (String.length session.token = 64);
114
+
Alcotest.(check bool)
115
+
"future expiry" true
116
+
(session.expires_at > Unix.gettimeofday ());
117
+
let found = Auth.Store.find_session store session.token in
118
+
Alcotest.(check bool) "found" true (Option.is_some found);
119
+
Alcotest.(check int) "same user" user.id (Option.get found).user_id
120
+
121
+
let test_session_not_found () =
122
+
with_store @@ fun _env _sw store ->
123
+
Alcotest.(check bool)
124
+
"not found" true
125
+
(Option.is_none (Auth.Store.find_session store "nonexistent"))
126
+
127
+
let test_delete_session () =
128
+
with_store @@ fun _env _sw store ->
129
+
let user =
130
+
Auth.Store.create_user store ~email:"f@x.com" ~name:"F" ~avatar_url:""
131
+
~provider:"github" ~provider_uid:"44444" ~access_token:"tok"
81
132
in
82
-
let resp = Requests.get http ~headers (base_url port ^ "/auth/signout") in
83
-
Alcotest.(check int)
84
-
"signout returns redirect" 302
85
-
(Response.status_code resp);
133
+
let s = Auth.Store.create_session store ~user_id:user.id in
86
134
Alcotest.(check bool)
87
-
"session deleted on signout" true
88
-
(Option.is_none (Auth.Store.find_session store session.token))
135
+
"exists" true
136
+
(Option.is_some (Auth.Store.find_session store s.token));
137
+
Auth.Store.delete_session store s.token;
138
+
Alcotest.(check bool)
139
+
"gone" true
140
+
(Option.is_none (Auth.Store.find_session store s.token))
89
141
90
-
let test_callback_uses_form_urlencoded_token_exchange () =
91
-
Eio_main.run @@ fun env ->
92
-
Eio.Switch.run @@ fun sw ->
93
-
let provider_port = next_port () in
94
-
let auth_port = next_port () in
95
-
let captured_headers = ref None in
96
-
let captured_body = ref None in
97
-
let token_routes =
98
-
[
99
-
Respond.post "/token" (fun req ->
100
-
captured_headers := Some req.headers;
101
-
captured_body := Some req.body;
102
-
Respond.Response.json {|{"access_token":"tok"}|});
103
-
]
142
+
let test_delete_nonexistent () =
143
+
with_store @@ fun _env _sw store ->
144
+
Auth.Store.delete_session store "does_not_exist"
145
+
146
+
let test_multiple_sessions_same_user () =
147
+
with_store @@ fun _env _sw store ->
148
+
let user =
149
+
Auth.Store.create_user store ~email:"g@x.com" ~name:"G" ~avatar_url:""
150
+
~provider:"github" ~provider_uid:"55555" ~access_token:"tok"
104
151
in
105
-
start_server env ~sw ~port:provider_port token_routes;
106
-
let server_http =
107
-
Requests.v ~sw ~follow_redirects:false ~timeout:requests_timeout env
152
+
let s1 = Auth.Store.create_session store ~user_id:user.id in
153
+
let s2 = Auth.Store.create_session store ~user_id:user.id in
154
+
Alcotest.(check bool) "different tokens" true (s1.token <> s2.token);
155
+
Auth.Store.delete_session store s1.token;
156
+
Alcotest.(check bool)
157
+
"s1 gone" true
158
+
(Option.is_none (Auth.Store.find_session store s1.token));
159
+
Alcotest.(check bool)
160
+
"s2 alive" true
161
+
(Option.is_some (Auth.Store.find_session store s2.token))
162
+
163
+
(* ── Cookie middleware ─────────────────────────────────────────── *)
164
+
165
+
let dummy_cfg =
166
+
(* http field is not used in cookie extraction path *)
167
+
Auth.config ~oauth_provider:Oauth.Github ~client_id:"" ~client_secret:""
168
+
~base_url:"http://localhost"
169
+
~cookie_secret:"test-secret-at-least-32-characters-long"
170
+
~http:(Obj.magic ())
171
+
172
+
let test_no_cookie () =
173
+
with_store @@ fun _env _sw store ->
174
+
Alcotest.(check bool)
175
+
"none" true
176
+
(Option.is_none
177
+
(Auth.current_user_from_params dummy_cfg store [] Headers.empty))
178
+
179
+
let test_invalid_token () =
180
+
with_store @@ fun _env _sw store ->
181
+
let h = Headers.set_string "cookie" "sid=bogus" Headers.empty in
182
+
Alcotest.(check bool)
183
+
"none" true
184
+
(Option.is_none (Auth.current_user_from_params dummy_cfg store [] h))
185
+
186
+
let test_valid_session_cookie () =
187
+
with_store @@ fun _env _sw store ->
188
+
let user =
189
+
Auth.Store.create_user store ~email:"h@x.com" ~name:"H" ~avatar_url:""
190
+
~provider:"github" ~provider_uid:"66666" ~access_token:"tok"
108
191
in
109
-
let client =
110
-
Requests.v ~sw ~follow_redirects:false ~timeout:requests_timeout env
192
+
let s = Auth.Store.create_session store ~user_id:user.id in
193
+
let h =
194
+
Headers.set_string "cookie" (Fmt.str "sid=%s" s.token) Headers.empty
195
+
in
196
+
let found = Auth.current_user_from_params dummy_cfg store [] h in
197
+
Alcotest.(check bool) "found" true (Option.is_some found);
198
+
Alcotest.(check int) "correct user" user.id (Option.get found).id
199
+
200
+
let test_cookie_among_others () =
201
+
with_store @@ fun _env _sw store ->
202
+
let user =
203
+
Auth.Store.create_user store ~email:"i@x.com" ~name:"I" ~avatar_url:""
204
+
~provider:"github" ~provider_uid:"77777" ~access_token:"tok"
111
205
in
112
-
let store = Auth.Store.v ~sw (temp_db_path env "callback") in
113
-
let provider =
114
-
{
115
-
Oauth.name = "google";
116
-
authorize_url = base_url provider_port ^ "/authorize";
117
-
token_url = base_url provider_port ^ "/token";
118
-
}
206
+
let s = Auth.Store.create_session store ~user_id:user.id in
207
+
let h =
208
+
Headers.set_string "cookie"
209
+
(Fmt.str "theme=dark; sid=%s; lang=en" s.token)
210
+
Headers.empty
119
211
in
120
-
let config =
121
-
Auth.config ~oauth_provider:provider ~client_id:"client"
122
-
~client_secret:"secret" ~base_url:(base_url auth_port)
123
-
~cookie_secret:"cookie-secret" ~http:server_http
212
+
let found = Auth.current_user_from_params dummy_cfg store [] h in
213
+
Alcotest.(check bool) "found" true (Option.is_some found);
214
+
Alcotest.(check int) "correct user" user.id (Option.get found).id
215
+
216
+
let test_revoked_session_cookie () =
217
+
with_store @@ fun _env _sw store ->
218
+
let user =
219
+
Auth.Store.create_user store ~email:"j@x.com" ~name:"J" ~avatar_url:""
220
+
~provider:"github" ~provider_uid:"88888" ~access_token:"tok"
124
221
in
125
-
start_server env ~sw ~port:auth_port (Auth.routes config store);
126
-
let signin = Requests.get client (base_url auth_port ^ "/auth/signin") in
127
-
let location =
128
-
match Response.headers signin |> Headers.find `Location with
129
-
| Some location -> location
130
-
| None -> Alcotest.fail "signin route did not redirect"
222
+
let s = Auth.Store.create_session store ~user_id:user.id in
223
+
Auth.Store.delete_session store s.token;
224
+
let h =
225
+
Headers.set_string "cookie" (Fmt.str "sid=%s" s.token) Headers.empty
131
226
in
132
-
let state =
133
-
match
134
-
Uri.of_string location |> fun uri -> Uri.get_query_param uri "state"
135
-
with
136
-
| Some state -> state
137
-
| None -> Alcotest.fail "signin redirect missing state"
227
+
Alcotest.(check bool)
228
+
"none after revoke" true
229
+
(Option.is_none (Auth.current_user_from_params dummy_cfg store [] h))
230
+
231
+
(* ── Userinfo parsing (via Oauth.parse_userinfo) ─────────────── *)
232
+
233
+
let test_github_userinfo () =
234
+
let body =
235
+
{|{"id":12345,"login":"octocat","email":"octocat@github.com","name":"The Octocat","avatar_url":"https://avatars.githubusercontent.com/u/12345"}|}
138
236
in
139
-
ignore
140
-
(Requests.get client
141
-
(Fmt.str "%s/auth/callback?code=abc&state=%s" (base_url auth_port)
142
-
(Uri.pct_encode state)));
143
-
let headers =
144
-
match !captured_headers with
145
-
| Some headers -> headers
146
-
| None -> Alcotest.fail "token endpoint was not called"
237
+
match Oauth.parse_userinfo Github body with
238
+
| Error e -> Alcotest.fail e
239
+
| Ok u ->
240
+
Alcotest.(check string) "uid" "12345" u.uid;
241
+
Alcotest.(check string) "login" "octocat" u.login;
242
+
Alcotest.(check string) "email" "octocat@github.com" u.email
243
+
244
+
let test_google_userinfo () =
245
+
let body =
246
+
{|{"sub":"118234567890","email":"user@gmail.com","name":"Test User","picture":"https://lh3.googleusercontent.com/photo.jpg"}|}
147
247
in
248
+
match Oauth.parse_userinfo Google body with
249
+
| Error e -> Alcotest.fail e
250
+
| Ok u ->
251
+
Alcotest.(check string) "uid" "118234567890" u.uid;
252
+
Alcotest.(check string) "email" "user@gmail.com" u.email;
253
+
Alcotest.(check string)
254
+
"avatar" "https://lh3.googleusercontent.com/photo.jpg" u.avatar_url
255
+
256
+
let test_gitlab_userinfo () =
148
257
let body =
149
-
match !captured_body with
150
-
| Some body -> body
151
-
| None -> Alcotest.fail "token endpoint body was not captured"
258
+
{|{"id":98765,"username":"jdoe","email":"jdoe@gitlab.com","name":"Jane Doe","avatar_url":"https://gitlab.com/uploads/-/system/user/avatar/98765/avatar.png"}|}
152
259
in
153
-
Alcotest.(check (option string))
154
-
"token exchange uses form content type"
155
-
(Some "application/x-www-form-urlencoded")
156
-
(Headers.find `Content_type headers);
157
-
Alcotest.(check bool)
158
-
"token exchange body is not JSON" false
159
-
(String.length body > 0 && body.[0] = '{');
160
-
Alcotest.(check bool)
161
-
"token exchange body includes authorization_code grant" true
162
-
(contains body ~substring:"grant_type=authorization_code")
260
+
match Oauth.parse_userinfo Gitlab body with
261
+
| Error e -> Alcotest.fail e
262
+
| Ok u ->
263
+
Alcotest.(check string) "uid" "98765" u.uid;
264
+
Alcotest.(check string) "login" "jdoe" u.login
163
265
164
-
let test_auth_source_is_not_hardwired_to_github () =
165
-
let source = read_file [ "lib/auth.ml"; "ocaml-auth/lib/auth.ml" ] in
166
-
Alcotest.(check bool)
167
-
"generic auth flow should not hardcode the GitHub profile endpoint" false
168
-
(contains source ~substring:"https://api.github.com/user")
266
+
let test_google_userinfo_rejects_missing_sub () =
267
+
let body = {|{"email":"user@gmail.com","name":"No Sub"}|} in
268
+
match Oauth.parse_userinfo Google body with
269
+
| Ok _ -> Alcotest.fail "should reject missing sub"
270
+
| Error _ -> ()
169
271
170
-
let test_auth_opam_has_real_metadata () =
171
-
let opam = read_file [ "auth.opam"; "ocaml-auth/auth.opam" ] in
172
-
Alcotest.(check bool)
173
-
"auth.opam declares dependencies" true
174
-
(contains opam ~substring:"depends:");
175
-
Alcotest.(check bool)
176
-
"auth.opam declares a build recipe" true
177
-
(contains opam ~substring:"build:")
272
+
let test_github_userinfo_with_null_email () =
273
+
(* GitHub returns null email when user hasn't set it public *)
274
+
let body = {|{"id":999,"login":"ghost","name":"Ghost"}|} in
275
+
match Oauth.parse_userinfo Github body with
276
+
| Error e -> Alcotest.fail e
277
+
| Ok u ->
278
+
Alcotest.(check string) "uid" "999" u.uid;
279
+
Alcotest.(check string) "email empty" "" u.email
178
280
179
-
let test_library_name_avoids_top_level_auth_module () =
180
-
let dune = read_file [ "lib/dune"; "ocaml-auth/lib/dune" ] in
181
-
Alcotest.(check bool)
182
-
"library should not publish a top-level Auth module name" false
183
-
(contains dune ~substring:"(name auth)")
281
+
let test_custom_provider_userinfo () =
282
+
let provider =
283
+
Oauth.Custom
284
+
{
285
+
name = "corp";
286
+
authorize_url = "";
287
+
token_url = "";
288
+
userinfo_url = "";
289
+
uid_field = "employee_id";
290
+
}
291
+
in
292
+
let body = {|{"employee_id":"EMP-42","email":"a@corp.com","name":"A"}|} in
293
+
match Oauth.parse_userinfo provider body with
294
+
| Error e -> Alcotest.fail e
295
+
| Ok u ->
296
+
Alcotest.(check string) "uid" "EMP-42" u.uid;
297
+
Alcotest.(check string) "email" "a@corp.com" u.email
298
+
299
+
let test_userinfo_rejects_garbage () =
300
+
match Oauth.parse_userinfo Github "not json at all" with
301
+
| Ok _ -> Alcotest.fail "should reject garbage"
302
+
| Error _ -> ()
303
+
304
+
(* ── Suite ─────────────────────────────────────────────────────── *)
184
305
185
306
let suite =
186
307
( "auth",
187
308
[
188
-
Alcotest.test_case "store rejects invalid database" `Quick
189
-
test_store_v_rejects_invalid_database;
190
-
Alcotest.test_case "signout revokes session" `Quick
191
-
test_signout_revokes_server_session;
192
-
Alcotest.test_case "callback token exchange uses form encoding" `Quick
193
-
test_callback_uses_form_urlencoded_token_exchange;
194
-
Alcotest.test_case "source is not hardwired to github" `Quick
195
-
test_auth_source_is_not_hardwired_to_github;
196
-
Alcotest.test_case "auth.opam has real metadata" `Quick
197
-
test_auth_opam_has_real_metadata;
198
-
Alcotest.test_case "library name avoids top-level Auth module" `Quick
199
-
test_library_name_avoids_top_level_auth_module;
309
+
(* Store *)
310
+
Alcotest.test_case "invalid database" `Quick
311
+
test_store_rejects_invalid_database;
312
+
Alcotest.test_case "create and find user" `Quick test_create_and_find_user;
313
+
Alcotest.test_case "find by provider" `Quick test_find_user_by_provider;
314
+
Alcotest.test_case "wrong provider/uid" `Quick
315
+
test_wrong_provider_returns_none;
316
+
Alcotest.test_case "nonexistent user" `Quick test_nonexistent_user;
317
+
Alcotest.test_case "multiple users" `Quick test_multiple_users;
318
+
(* Sessions *)
319
+
Alcotest.test_case "create and find session" `Quick
320
+
test_create_and_find_session;
321
+
Alcotest.test_case "session not found" `Quick test_session_not_found;
322
+
Alcotest.test_case "delete session" `Quick test_delete_session;
323
+
Alcotest.test_case "delete nonexistent" `Quick test_delete_nonexistent;
324
+
Alcotest.test_case "multiple sessions" `Quick
325
+
test_multiple_sessions_same_user;
326
+
(* Cookie middleware *)
327
+
Alcotest.test_case "no cookie" `Quick test_no_cookie;
328
+
Alcotest.test_case "invalid token" `Quick test_invalid_token;
329
+
Alcotest.test_case "valid session" `Quick test_valid_session_cookie;
330
+
Alcotest.test_case "cookie among others" `Quick test_cookie_among_others;
331
+
Alcotest.test_case "revoked session" `Quick test_revoked_session_cookie;
332
+
(* Userinfo parsing *)
333
+
Alcotest.test_case "github userinfo" `Quick test_github_userinfo;
334
+
Alcotest.test_case "google userinfo" `Quick test_google_userinfo;
335
+
Alcotest.test_case "gitlab userinfo" `Quick test_gitlab_userinfo;
336
+
Alcotest.test_case "google rejects missing sub" `Quick
337
+
test_google_userinfo_rejects_missing_sub;
338
+
Alcotest.test_case "github null email" `Quick
339
+
test_github_userinfo_with_null_email;
340
+
Alcotest.test_case "custom provider" `Quick test_custom_provider_userinfo;
341
+
Alcotest.test_case "garbage input" `Quick test_userinfo_rejects_garbage;
200
342
] )