OAuth 2.0 authorization and token exchange
Validate token_type in token response, reject non-Bearer tokens
parse_token_response now parses the token_type field (RFC 6749 §5.1)
and rejects anything other than "bearer" (case-insensitive). Missing
token_type is accepted as Bearer (GitHub omits it). Previously, MAC
or DPoP tokens were silently accepted and would be sent as Bearer,
creating a confused-deputy situation.
New error variant: Unsupported_token_type of string.
4 new tests: rejects mac, accepts Bearer, case-insensitive, missing.
+89
-5
+45
-5
lib/oauth.ml
+45
-5
lib/oauth.ml
···
276
276
refresh_token_expires_in : int option;
277
277
}
278
278
279
-
let token_response_jsont =
279
+
type raw_token_response = {
280
+
access_token : string;
281
+
token_type : string option;
282
+
expires_in : int option;
283
+
refresh_token : string option;
284
+
refresh_token_expires_in : int option;
285
+
}
286
+
287
+
let raw_token_response_jsont =
280
288
Jsont.Object.map ~kind:"token_response"
281
-
(fun access_token expires_in refresh_token refresh_token_expires_in ->
282
-
{ access_token; expires_in; refresh_token; refresh_token_expires_in })
289
+
(fun
290
+
access_token
291
+
token_type
292
+
expires_in
293
+
refresh_token
294
+
refresh_token_expires_in
295
+
->
296
+
{
297
+
access_token;
298
+
token_type;
299
+
expires_in;
300
+
refresh_token;
301
+
refresh_token_expires_in;
302
+
})
283
303
|> Jsont.Object.mem "access_token" Jsont.string ~enc:(fun t -> t.access_token)
304
+
|> Jsont.Object.opt_mem "token_type" Jsont.string ~enc:(fun t -> t.token_type)
284
305
|> Jsont.Object.opt_mem "expires_in" Jsont.int ~enc:(fun t -> t.expires_in)
285
306
|> Jsont.Object.opt_mem "refresh_token" Jsont.string ~enc:(fun t ->
286
307
t.refresh_token)
···
292
313
| Invalid_json
293
314
| Missing_access_token
294
315
| Invalid_token_format
316
+
| Unsupported_token_type of string
295
317
296
318
let pp_parse_token_error fmt = function
297
319
| Invalid_json -> Fmt.pf fmt "Invalid JSON"
298
320
| Missing_access_token -> Fmt.pf fmt "Missing access_token field"
299
321
| Invalid_token_format -> Fmt.pf fmt "Invalid token format"
322
+
| Unsupported_token_type t ->
323
+
Fmt.pf fmt "Unsupported token_type %S (only Bearer is supported)" t
300
324
301
325
let has_substring ~sub s =
302
326
let len = String.length sub in
···
317
341
then Missing_access_token
318
342
else Invalid_token_format
319
343
344
+
let is_bearer = function
345
+
| None -> true (* GitHub omits token_type; default is Bearer *)
346
+
| Some s -> String.lowercase_ascii s = "bearer"
347
+
320
348
let parse_token_response body =
321
-
match decode token_response_jsont body with
349
+
match decode raw_token_response_jsont body with
322
350
| Ok t ->
323
351
if t.access_token = "" then begin
324
352
Log.warn (fun m -> m "Token parse failed: empty access_token");
325
353
Error Missing_access_token
326
354
end
327
-
else Ok t
355
+
else if not (is_bearer t.token_type) then begin
356
+
let tt = Option.get t.token_type in
357
+
Log.warn (fun m -> m "Token parse failed: unsupported token_type %S" tt);
358
+
Error (Unsupported_token_type tt)
359
+
end
360
+
else
361
+
Ok
362
+
{
363
+
access_token = t.access_token;
364
+
expires_in = t.expires_in;
365
+
refresh_token = t.refresh_token;
366
+
refresh_token_expires_in = t.refresh_token_expires_in;
367
+
}
328
368
| Error e ->
329
369
let err = classify_token_error body e in
330
370
Log.warn (fun m -> m "Token parse failed: %a" pp_parse_token_error err);
+3
lib/oauth.mli
+3
lib/oauth.mli
···
254
254
| Invalid_json
255
255
| Missing_access_token
256
256
| Invalid_token_format
257
+
| Unsupported_token_type of string
258
+
(** The server returned a [token_type] other than ["bearer"]. This library
259
+
only supports Bearer tokens (RFC 6750). *)
257
260
258
261
val parse_token_response : string -> (token_response, parse_token_error) result
259
262
(** [parse_token_response body] parses a JSON token response. *)
+41
test/test_regressions.ml
+41
test/test_regressions.ml
···
114
114
"access_token wrong type" (Error Oauth.Invalid_token_format)
115
115
(Oauth.parse_token_response body)
116
116
117
+
let test_parse_token_response_rejects_mac_token () =
118
+
let body =
119
+
{|{"access_token":"tok_abc","token_type":"mac","expires_in":3600}|}
120
+
in
121
+
match Oauth.parse_token_response body with
122
+
| Error (Oauth.Unsupported_token_type "mac") -> ()
123
+
| Error e -> Alcotest.failf "wrong error: %a" Oauth.pp_parse_token_error e
124
+
| Ok _ -> Alcotest.fail "expected rejection of mac token_type"
125
+
126
+
let test_parse_token_response_accepts_bearer () =
127
+
let body =
128
+
{|{"access_token":"tok_abc","token_type":"Bearer","expires_in":3600}|}
129
+
in
130
+
match Oauth.parse_token_response body with
131
+
| Ok t -> Alcotest.(check string) "access_token" "tok_abc" t.access_token
132
+
| Error e ->
133
+
Alcotest.failf "unexpected error: %a" Oauth.pp_parse_token_error e
134
+
135
+
let test_parse_token_response_accepts_bearer_case_insensitive () =
136
+
let body = {|{"access_token":"tok_abc","token_type":"BEARER"}|} in
137
+
match Oauth.parse_token_response body with
138
+
| Ok t -> Alcotest.(check string) "access_token" "tok_abc" t.access_token
139
+
| Error e ->
140
+
Alcotest.failf "unexpected error: %a" Oauth.pp_parse_token_error e
141
+
142
+
let test_parse_token_response_accepts_missing_token_type () =
143
+
(* GitHub omits token_type *)
144
+
let body = {|{"access_token":"gho_abc"}|} in
145
+
match Oauth.parse_token_response body with
146
+
| Ok t -> Alcotest.(check string) "access_token" "gho_abc" t.access_token
147
+
| Error e ->
148
+
Alcotest.failf "unexpected error: %a" Oauth.pp_parse_token_error e
149
+
117
150
let custom name =
118
151
match
119
152
Oauth.custom_provider ~name ~authorize_url:"https://example.com/auth"
···
328
361
test_parse_token_response_empty_access_token;
329
362
Alcotest.test_case "parse_token_response invalid format" `Quick
330
363
test_parse_token_response_invalid_format;
364
+
Alcotest.test_case "parse_token_response rejects mac" `Quick
365
+
test_parse_token_response_rejects_mac_token;
366
+
Alcotest.test_case "parse_token_response accepts bearer" `Quick
367
+
test_parse_token_response_accepts_bearer;
368
+
Alcotest.test_case "parse_token_response bearer case-insensitive" `Quick
369
+
test_parse_token_response_accepts_bearer_case_insensitive;
370
+
Alcotest.test_case "parse_token_response accepts missing token_type"
371
+
`Quick test_parse_token_response_accepts_missing_token_type;
331
372
Alcotest.test_case "provider_name is raw" `Quick test_provider_name_is_raw;
332
373
Alcotest.test_case "provider_slug is path-safe" `Quick
333
374
test_provider_slug_is_path_safe;