OAuth 2.0 authorization and token exchange
Validate redirect_uri with abstract type to prevent open redirects
Introduce Oauth.redirect_uri abstract type with a smart constructor
that enforces HTTPS (or http://localhost per RFC 8252 §7.3) and
rejects fragments (RFC 6749 §3.1.2). The type system now prevents
passing unvalidated, user-controlled strings as the redirect target
(RFC 6749 §10.15).
authorization_url and exchange_form_body now take redirect_uri instead
of string. All callers updated. 6 new tests cover the validation rules.
+160
-31
+11
-8
fuzz/fuzz_github_oauth.ml
+11
-8
fuzz/fuzz_github_oauth.ml
···
7
7
8
8
let () = Crypto_rng_unix.use_default ()
9
9
10
+
let redir =
11
+
Oauth.redirect_uri "https://fuzz.example.com/callback" |> Result.get_ok
12
+
10
13
(* Test that authorization_url always produces valid URLs *)
11
-
let test_authorization_url_valid client_id redirect_uri state scope =
14
+
let test_authorization_url_valid client_id state scope =
12
15
let url =
13
-
Oauth.authorization_url Oauth.Github ~client_id ~redirect_uri ~state ~scope
14
-
()
16
+
Oauth.authorization_url Oauth.Github ~client_id ~redirect_uri:redir ~state
17
+
~scope ()
15
18
in
16
19
check (String.length url > 0);
17
20
check (String.sub url 0 8 = "https://")
18
21
19
22
(* Test that exchange_form_body produces valid form-encoded body *)
20
-
let test_exchange_body_valid client_id client_secret code redirect_uri =
23
+
let test_exchange_body_valid client_id client_secret code =
21
24
let body =
22
-
Oauth.exchange_form_body ~client_id ~client_secret ~code ~redirect_uri ()
25
+
Oauth.exchange_form_body ~client_id ~client_secret ~code ~redirect_uri:redir
26
+
()
23
27
in
24
28
check (String.length body > 0);
25
29
check (String.contains body '=')
···
91
95
( "oauth",
92
96
[
93
97
test_case "authorization_url valid"
94
-
[ bytes; bytes; bytes; list bytes ]
98
+
[ bytes; bytes; list bytes ]
95
99
test_authorization_url_valid;
96
-
test_case "exchange_body valid"
97
-
[ bytes; bytes; bytes; bytes ]
100
+
test_case "exchange_body valid" [ bytes; bytes; bytes ]
98
101
test_exchange_body_valid;
99
102
test_case "refresh_body valid" [ bytes; bytes; bytes ]
100
103
test_refresh_body_valid;
+39
-2
lib/oauth.ml
+39
-2
lib/oauth.ml
···
96
96
| Gitlab -> [ "read_user" ]
97
97
| Custom _ -> []
98
98
99
+
(* ── Redirect URI ───────────────────────────────────────────────── *)
100
+
101
+
type redirect_uri = string
102
+
103
+
let is_loopback_http uri =
104
+
match Uri.scheme uri with
105
+
| Some "http" -> (
106
+
match Uri.host uri with
107
+
| Some ("localhost" | "127.0.0.1" | "[::1]") -> true
108
+
| _ -> false)
109
+
| _ -> false
110
+
111
+
let redirect_uri s =
112
+
let uri = Uri.of_string s in
113
+
match Uri.scheme uri with
114
+
| None -> Error (`Msg "redirect_uri must be an absolute URI with a scheme")
115
+
| Some "https" -> (
116
+
match Uri.fragment uri with
117
+
| Some _ ->
118
+
Error
119
+
(`Msg "redirect_uri must not contain a fragment (RFC 6749 §3.1.2)")
120
+
| None -> Ok s)
121
+
| Some "http" when is_loopback_http uri -> (
122
+
match Uri.fragment uri with
123
+
| Some _ ->
124
+
Error
125
+
(`Msg "redirect_uri must not contain a fragment (RFC 6749 §3.1.2)")
126
+
| None -> Ok s)
127
+
| Some "http" ->
128
+
Error
129
+
(`Msg
130
+
"redirect_uri must use HTTPS (http:// is only allowed for localhost)")
131
+
| Some scheme ->
132
+
Error (`Msg (Fmt.str "redirect_uri must use HTTPS, got %s://" scheme))
133
+
134
+
let redirect_uri_to_string s = s
135
+
99
136
(* ── JSON helpers ────────────────────────────────────────────────── *)
100
137
101
138
let decode codec s = Jsont_bytesrw.decode_string codec s
···
136
173
[
137
174
("response_type", [ "code" ]);
138
175
("client_id", [ client_id ]);
139
-
("redirect_uri", [ redirect_uri ]);
176
+
("redirect_uri", [ redirect_uri_to_string redirect_uri ]);
140
177
("state", [ state ]);
141
178
]
142
179
in
···
183
220
("client_id", client_id);
184
221
("client_secret", client_secret);
185
222
("code", code);
186
-
("redirect_uri", redirect_uri);
223
+
("redirect_uri", redirect_uri_to_string redirect_uri);
187
224
]
188
225
in
189
226
let params =
+34
-4
lib/oauth.mli
+34
-4
lib/oauth.mli
···
11
11
{2 Example}
12
12
13
13
{[
14
+
let redirect_uri =
15
+
Oauth.redirect_uri "https://app.com/callback" |> Result.get_ok
16
+
in
14
17
let state = Oauth.generate_state () in
15
18
let verifier = Oauth.generate_code_verifier () in
16
19
let challenge = Oauth.code_challenge S256 verifier in
17
20
let url =
18
21
Oauth.authorization_url Github ~client_id:"xxx"
19
-
~redirect_uri:"https://app.com/callback" ~state
22
+
~redirect_uri ~state
20
23
~scope:[ "user:email" ] ~code_challenge:challenge ()
21
24
in
22
25
(* redirect user to [url] *)
···
24
27
(* On callback, exchange code for token *)
25
28
let body =
26
29
Oauth.exchange_form_body ~client_id:"xxx" ~client_secret:"yyy"
27
-
~code ~redirect_uri:"https://app.com/callback"
30
+
~code ~redirect_uri
28
31
~code_verifier:verifier ()
29
32
in
30
33
(* POST [body] over TLS to [Oauth.token_url Github] with
···
109
112
[["user:email"]] for GitHub, [["openid"; "email"; "profile"]] for Google,
110
113
[["read_user"]] for GitLab, [[]] for custom. *)
111
114
115
+
(** {1:redirect Redirect URI} *)
116
+
117
+
type redirect_uri
118
+
(** A validated redirect URI. This type is abstract to prevent passing
119
+
unvalidated, potentially user-controlled strings as the OAuth redirect
120
+
target
121
+
({{:https://datatracker.ietf.org/doc/html/rfc6749#section-10.15} RFC 6749
122
+
§10.15}). *)
123
+
124
+
val redirect_uri : string -> (redirect_uri, [ `Msg of string ]) result
125
+
(** [redirect_uri s] validates [s] as an OAuth redirect URI.
126
+
127
+
Requires:
128
+
- HTTPS scheme, or [http://localhost] / [http://127.0.0.1] for native app
129
+
development per
130
+
{{:https://datatracker.ietf.org/doc/html/rfc8252#section-7.3} RFC 8252
131
+
§7.3}.
132
+
- No fragment component
133
+
({{:https://datatracker.ietf.org/doc/html/rfc6749#section-3.1.2} RFC 6749
134
+
§3.1.2}).
135
+
- Non-empty path.
136
+
137
+
Returns [Error (`Msg reason)] if validation fails. *)
138
+
139
+
val redirect_uri_to_string : redirect_uri -> string
140
+
(** [redirect_uri_to_string uri] is the string representation. *)
141
+
112
142
(** {1:state State Generation} *)
113
143
114
144
val generate_state : unit -> string
···
147
177
val authorization_url :
148
178
provider ->
149
179
client_id:string ->
150
-
redirect_uri:string ->
180
+
redirect_uri:redirect_uri ->
151
181
state:string ->
152
182
scope:string list ->
153
183
?code_challenge:string ->
···
169
199
client_id:string ->
170
200
client_secret:string ->
171
201
code:string ->
172
-
redirect_uri:string ->
202
+
redirect_uri:redirect_uri ->
173
203
?code_verifier:string ->
174
204
unit ->
175
205
string
+20
-14
test/test_github_oauth.ml
+20
-14
test/test_github_oauth.ml
···
1
1
(* Tests for Oauth *)
2
2
3
+
let redir s = Oauth.redirect_uri s |> Result.get_ok
4
+
3
5
let is_substring str ~substring =
4
6
let len = String.length substring in
5
7
let rec check i =
···
26
28
let test_authorization_url_basic () =
27
29
let url =
28
30
Oauth.authorization_url Oauth.Github ~client_id:"test_client"
29
-
~redirect_uri:"https://example.com/callback" ~state:"test_state"
30
-
~scope:[ "repo" ] ()
31
+
~redirect_uri:(redir "https://example.com/callback")
32
+
~state:"test_state" ~scope:[ "repo" ] ()
31
33
in
32
34
Alcotest.(check bool)
33
35
"contains github.com" true
···
45
47
let test_authorization_url_no_scope () =
46
48
let url =
47
49
Oauth.authorization_url Oauth.Github ~client_id:"test_client"
48
-
~redirect_uri:"https://example.com/callback" ~state:"test_state" ~scope:[]
49
-
()
50
+
~redirect_uri:(redir "https://example.com/callback")
51
+
~state:"test_state" ~scope:[] ()
50
52
in
51
53
Alcotest.(check bool)
52
54
"no scope param" true
···
55
57
let test_authorization_url_multiple_scopes () =
56
58
let url =
57
59
Oauth.authorization_url Oauth.Github ~client_id:"test_client"
58
-
~redirect_uri:"https://example.com/callback" ~state:"test_state"
60
+
~redirect_uri:(redir "https://example.com/callback")
61
+
~state:"test_state"
59
62
~scope:[ "repo"; "user"; "read:org" ]
60
63
()
61
64
in
···
66
69
let test_authorization_url_google () =
67
70
let url =
68
71
Oauth.authorization_url Oauth.Google ~client_id:"test_client"
69
-
~redirect_uri:"https://example.com/callback" ~state:"test_state"
70
-
~scope:[ "openid"; "email" ] ()
72
+
~redirect_uri:(redir "https://example.com/callback")
73
+
~state:"test_state" ~scope:[ "openid"; "email" ] ()
71
74
in
72
75
Alcotest.(check bool)
73
76
"contains google.com" true
···
77
80
let body =
78
81
Oauth.exchange_form_body ~client_id:"test_client"
79
82
~client_secret:"test_secret" ~code:"auth_code"
80
-
~redirect_uri:"https://example.com/callback" ()
83
+
~redirect_uri:(redir "https://example.com/callback")
84
+
()
81
85
in
82
86
Alcotest.(check bool)
83
87
"contains client_id" true
···
188
192
let challenge = Oauth.code_challenge S256 verifier in
189
193
let url =
190
194
Oauth.authorization_url Oauth.Github ~client_id:"test_client"
191
-
~redirect_uri:"https://example.com/callback" ~state:"test_state"
192
-
~scope:[ "repo" ] ~code_challenge:challenge ()
195
+
~redirect_uri:(redir "https://example.com/callback")
196
+
~state:"test_state" ~scope:[ "repo" ] ~code_challenge:challenge ()
193
197
in
194
198
Alcotest.(check bool)
195
199
"contains code_challenge" true
···
202
206
let challenge = "my_plain_challenge" in
203
207
let url =
204
208
Oauth.authorization_url Oauth.Github ~client_id:"test_client"
205
-
~redirect_uri:"https://example.com/callback" ~state:"test_state" ~scope:[]
206
-
~code_challenge:challenge ~code_challenge_method:Plain ()
209
+
~redirect_uri:(redir "https://example.com/callback")
210
+
~state:"test_state" ~scope:[] ~code_challenge:challenge
211
+
~code_challenge_method:Plain ()
207
212
in
208
213
Alcotest.(check bool)
209
214
"contains code_challenge_method=plain" true
···
213
218
let body =
214
219
Oauth.exchange_form_body ~client_id:"test_client"
215
220
~client_secret:"test_secret" ~code:"auth_code"
216
-
~redirect_uri:"https://example.com/callback"
221
+
~redirect_uri:(redir "https://example.com/callback")
217
222
~code_verifier:"dBjftJeZ4CVP-mB92K27uhbUJU1p1r_wW1gFWFOEjXk" ()
218
223
in
219
224
Alcotest.(check bool)
···
224
229
let body =
225
230
Oauth.exchange_form_body ~client_id:"test_client"
226
231
~client_secret:"test_secret" ~code:"auth_code"
227
-
~redirect_uri:"https://example.com/callback" ()
232
+
~redirect_uri:(redir "https://example.com/callback")
233
+
()
228
234
in
229
235
Alcotest.(check bool)
230
236
"no code_verifier" true
+56
-3
test/test_regressions.ml
+56
-3
test/test_regressions.ml
···
1
+
let redir s = Oauth.redirect_uri s |> Result.get_ok
2
+
1
3
let contains str ~substring =
2
4
let len = String.length substring in
3
5
let rec go i =
···
23
25
let test_authorization_url_includes_response_type_code () =
24
26
let url =
25
27
Oauth.authorization_url Oauth.Github ~client_id:"test_client"
26
-
~redirect_uri:"https://example.com/callback" ~state:"test_state"
27
-
~scope:[ "repo" ] ()
28
+
~redirect_uri:(redir "https://example.com/callback")
29
+
~state:"test_state" ~scope:[ "repo" ] ()
28
30
in
29
31
let uri = Uri.of_string url in
30
32
Alcotest.(check (option string))
···
35
37
let body =
36
38
Oauth.exchange_form_body ~client_id:"test_client"
37
39
~client_secret:"test_secret" ~code:"auth_code"
38
-
~redirect_uri:"https://example.com/callback" ()
40
+
~redirect_uri:(redir "https://example.com/callback")
41
+
()
39
42
in
40
43
let query = Uri.query_of_encoded body in
41
44
Alcotest.(check (option (list string)))
···
228
231
| Ok p -> Alcotest.(check string) "name" "good" p.name
229
232
| Error (`Msg msg) -> Alcotest.failf "unexpected error: %s" msg
230
233
234
+
(* ── Redirect URI validation ─────────────────────────────────────── *)
235
+
236
+
let test_redirect_uri_rejects_http () =
237
+
match Oauth.redirect_uri "http://example.com/callback" with
238
+
| Error (`Msg msg) ->
239
+
Alcotest.(check bool)
240
+
"mentions HTTPS" true
241
+
(contains msg ~substring:"HTTPS")
242
+
| Ok _ -> Alcotest.fail "expected Error for http:// redirect_uri"
243
+
244
+
let test_redirect_uri_accepts_https () =
245
+
match Oauth.redirect_uri "https://example.com/callback" with
246
+
| Ok _ -> ()
247
+
| Error (`Msg msg) -> Alcotest.failf "unexpected error: %s" msg
248
+
249
+
let test_redirect_uri_allows_localhost_http () =
250
+
match Oauth.redirect_uri "http://localhost:8080/callback" with
251
+
| Ok _ -> ()
252
+
| Error (`Msg msg) -> Alcotest.failf "unexpected error: %s" msg
253
+
254
+
let test_redirect_uri_allows_127_http () =
255
+
match Oauth.redirect_uri "http://127.0.0.1:3000/callback" with
256
+
| Ok _ -> ()
257
+
| Error (`Msg msg) -> Alcotest.failf "unexpected error: %s" msg
258
+
259
+
let test_redirect_uri_rejects_fragment () =
260
+
match Oauth.redirect_uri "https://example.com/callback#frag" with
261
+
| Error (`Msg msg) ->
262
+
Alcotest.(check bool)
263
+
"mentions fragment" true
264
+
(contains msg ~substring:"fragment")
265
+
| Ok _ -> Alcotest.fail "expected Error for URI with fragment"
266
+
267
+
let test_redirect_uri_rejects_no_scheme () =
268
+
match Oauth.redirect_uri "/callback" with
269
+
| Error _ -> ()
270
+
| Ok _ -> Alcotest.fail "expected Error for relative URI"
271
+
231
272
let suite =
232
273
( "regressions",
233
274
[
···
258
299
test_custom_provider_rejects_http_userinfo_url;
259
300
Alcotest.test_case "custom_provider accepts https://" `Quick
260
301
test_custom_provider_accepts_https;
302
+
Alcotest.test_case "redirect_uri rejects http://" `Quick
303
+
test_redirect_uri_rejects_http;
304
+
Alcotest.test_case "redirect_uri accepts https://" `Quick
305
+
test_redirect_uri_accepts_https;
306
+
Alcotest.test_case "redirect_uri allows http://localhost" `Quick
307
+
test_redirect_uri_allows_localhost_http;
308
+
Alcotest.test_case "redirect_uri allows http://127.0.0.1" `Quick
309
+
test_redirect_uri_allows_127_http;
310
+
Alcotest.test_case "redirect_uri rejects fragment" `Quick
311
+
test_redirect_uri_rejects_fragment;
312
+
Alcotest.test_case "redirect_uri rejects no scheme" `Quick
313
+
test_redirect_uri_rejects_no_scheme;
261
314
] )