OAuth 2.0 authorization and token exchange
Linter fixes: auth refactor, github-oauth merge, respond cleanup
+205
-122
+1
-2
fuzz/fuzz_github_oauth.ml
+1
-2
fuzz/fuzz_github_oauth.ml
···
10
10
(* Test that authorization_url always produces valid URLs *)
11
11
let test_authorization_url_valid client_id redirect_uri state scope =
12
12
let url =
13
-
Oauth.authorization_url Oauth.Github.provider ~client_id ~redirect_uri
14
-
~state ~scope
13
+
Oauth.authorization_url Oauth.Github ~client_id ~redirect_uri ~state ~scope
15
14
in
16
15
check (String.length url > 0);
17
16
check (String.sub url 0 8 = "https://")
+116
-60
lib/oauth.ml
+116
-60
lib/oauth.ml
···
4
4
5
5
module Log = (val Logs.src_log src : Logs.LOG)
6
6
7
-
(* {1 Provider} *)
7
+
(* ── Providers ───────────────────────────────────────────────────── *)
8
8
9
-
type provider = {
9
+
type provider = Github | Google | Gitlab | Custom of custom_provider
10
+
11
+
and custom_provider = {
10
12
name : string;
11
13
authorize_url : string;
12
14
token_url : string;
13
15
userinfo_url : string;
16
+
uid_field : string;
14
17
}
15
18
16
-
(* {1 JSON helpers} *)
19
+
let provider_name = function
20
+
| Github -> "github"
21
+
| Google -> "google"
22
+
| Gitlab -> "gitlab"
23
+
| Custom c -> c.name
17
24
18
-
let decode codec s = Jsont_bytesrw.decode_string codec s
25
+
let authorize_url = function
26
+
| Github -> "https://github.com/login/oauth/authorize"
27
+
| Google -> "https://accounts.google.com/o/oauth2/v2/auth"
28
+
| Gitlab -> "https://gitlab.com/oauth/authorize"
29
+
| Custom c -> c.authorize_url
19
30
20
-
let encode codec v =
21
-
Jsont_bytesrw.encode_string codec v |> Result.value ~default:"{}"
31
+
let token_url = function
32
+
| Github -> "https://github.com/login/oauth/access_token"
33
+
| Google -> "https://oauth2.googleapis.com/token"
34
+
| Gitlab -> "https://gitlab.com/oauth/token"
35
+
| Custom c -> c.token_url
22
36
23
-
(* {1 State} *)
37
+
let userinfo_url = function
38
+
| Github -> "https://api.github.com/user"
39
+
| Google -> "https://www.googleapis.com/oauth2/v3/userinfo"
40
+
| Gitlab -> "https://gitlab.com/api/v4/user"
41
+
| Custom c -> c.userinfo_url
42
+
43
+
let default_scope = function
44
+
| Github -> [ "user:email" ]
45
+
| Google -> [ "openid"; "email"; "profile" ]
46
+
| Gitlab -> [ "read_user" ]
47
+
| Custom _ -> []
48
+
49
+
(* ── JSON helpers ────────────────────────────────────────────────── *)
50
+
51
+
let decode codec s = Jsont_bytesrw.decode_string codec s
52
+
53
+
(* ── State ───────────────────────────────────────────────────────── *)
24
54
25
55
let generate_state () = Ohex.encode (Crypto_rng.generate 32)
26
56
27
-
(* {1 Authorization URL} *)
57
+
(* ── Authorization URL ───────────────────────────────────────────── *)
28
58
29
59
let authorization_url provider ~client_id ~redirect_uri ~state ~scope =
30
-
let uri = Uri.of_string provider.authorize_url in
60
+
let uri = Uri.of_string (authorize_url provider) in
31
61
let base_query =
32
62
[
33
63
("response_type", [ "code" ]);
···
43
73
in
44
74
Uri.with_query uri query |> Uri.to_string
45
75
46
-
(* {1 Token Exchange} *)
47
-
48
-
let exchange_body_jsont =
49
-
Jsont.Object.map ~kind:"exchange_body"
50
-
(fun client_id client_secret code redirect_uri ->
51
-
(client_id, client_secret, code, redirect_uri))
52
-
|> Jsont.Object.mem "client_id" Jsont.string ~enc:(fun (c, _, _, _) -> c)
53
-
|> Jsont.Object.mem "client_secret" Jsont.string ~enc:(fun (_, s, _, _) -> s)
54
-
|> Jsont.Object.mem "code" Jsont.string ~enc:(fun (_, _, c, _) -> c)
55
-
|> Jsont.Object.mem "redirect_uri" Jsont.string ~enc:(fun (_, _, _, r) -> r)
56
-
|> Jsont.Object.finish
76
+
(* ── Token Exchange ──────────────────────────────────────────────── *)
57
77
58
78
let pct_encode s =
59
79
let buf = Buffer.create (String.length s) in
···
80
100
("redirect_uri", redirect_uri);
81
101
]
82
102
83
-
(* {1 Token Response} *)
103
+
(* ── Token Response ──────────────────────────────────────────────── *)
84
104
85
105
type token_response = {
86
106
access_token : string;
···
118
138
Log.warn (fun m -> m "Token parse failed: %s" e);
119
139
Error Invalid_json
120
140
121
-
(* {1 Token Refresh} *)
122
-
123
-
let refresh_body_jsont =
124
-
Jsont.Object.map ~kind:"refresh_body"
125
-
(fun client_id client_secret grant_type refresh_token ->
126
-
(client_id, client_secret, grant_type, refresh_token))
127
-
|> Jsont.Object.mem "client_id" Jsont.string ~enc:(fun (c, _, _, _) -> c)
128
-
|> Jsont.Object.mem "client_secret" Jsont.string ~enc:(fun (_, s, _, _) -> s)
129
-
|> Jsont.Object.mem "grant_type" Jsont.string ~enc:(fun (_, _, g, _) -> g)
130
-
|> Jsont.Object.mem "refresh_token" Jsont.string ~enc:(fun (_, _, _, r) -> r)
131
-
|> Jsont.Object.finish
141
+
(* ── Token Refresh ───────────────────────────────────────────────── *)
132
142
133
143
let refresh_form_body ~client_id ~client_secret ~refresh_token =
134
144
form_encode
···
139
149
("refresh_token", refresh_token);
140
150
]
141
151
142
-
(* {1 Providers} *)
152
+
(* ── Userinfo Parsing ────────────────────────────────────────────── *)
143
153
144
-
module Github = struct
145
-
let provider =
146
-
{
147
-
name = "github";
148
-
authorize_url = "https://github.com/login/oauth/authorize";
149
-
token_url = "https://github.com/login/oauth/access_token";
150
-
userinfo_url = "https://api.github.com/user";
151
-
}
152
-
end
154
+
type userinfo = {
155
+
uid : string;
156
+
login : string;
157
+
email : string;
158
+
name : string;
159
+
avatar_url : string;
160
+
}
153
161
154
-
module Google = struct
155
-
let provider =
156
-
{
157
-
name = "google";
158
-
authorize_url = "https://accounts.google.com/o/oauth2/v2/auth";
159
-
token_url = "https://oauth2.googleapis.com/token";
160
-
userinfo_url = "https://www.googleapis.com/oauth2/v3/userinfo";
161
-
}
162
-
end
162
+
(* GitHub: {"id":123,"login":"octocat","email":"...","name":"...","avatar_url":"..."} *)
163
+
let github_userinfo_jsont =
164
+
Jsont.Object.map ~kind:"github_userinfo"
165
+
(fun id login email name avatar_url ->
166
+
{ uid = string_of_int id; login; email; name; avatar_url })
167
+
|> Jsont.Object.mem "id" Jsont.int ~enc:(fun _ -> 0)
168
+
|> Jsont.Object.mem "login" Jsont.string ~dec_absent:"" ~enc:(fun u ->
169
+
u.login)
170
+
|> Jsont.Object.mem "email" Jsont.string ~dec_absent:"" ~enc:(fun u ->
171
+
u.email)
172
+
|> Jsont.Object.mem "name" Jsont.string ~dec_absent:"" ~enc:(fun u -> u.name)
173
+
|> Jsont.Object.mem "avatar_url" Jsont.string ~dec_absent:"" ~enc:(fun u ->
174
+
u.avatar_url)
175
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
163
176
164
-
module Gitlab = struct
165
-
let provider =
166
-
{
167
-
name = "gitlab";
168
-
authorize_url = "https://gitlab.com/oauth/authorize";
169
-
token_url = "https://gitlab.com/oauth/token";
170
-
userinfo_url = "https://gitlab.com/api/v4/user";
171
-
}
172
-
end
177
+
(* Google OIDC: {"sub":"118...","email":"...","name":"...","picture":"..."} *)
178
+
let google_userinfo_jsont =
179
+
Jsont.Object.map ~kind:"google_userinfo" (fun sub email name picture ->
180
+
{ uid = sub; login = ""; email; name; avatar_url = picture })
181
+
|> Jsont.Object.mem "sub" Jsont.string ~enc:(fun u -> u.uid)
182
+
|> Jsont.Object.mem "email" Jsont.string ~dec_absent:"" ~enc:(fun u ->
183
+
u.email)
184
+
|> Jsont.Object.mem "name" Jsont.string ~dec_absent:"" ~enc:(fun u -> u.name)
185
+
|> Jsont.Object.mem "picture" Jsont.string ~dec_absent:"" ~enc:(fun u ->
186
+
u.avatar_url)
187
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
188
+
189
+
(* GitLab: {"id":123,"username":"john","email":"...","name":"...","avatar_url":"..."} *)
190
+
let gitlab_userinfo_jsont =
191
+
Jsont.Object.map ~kind:"gitlab_userinfo"
192
+
(fun id username email name avatar_url ->
193
+
{ uid = string_of_int id; login = username; email; name; avatar_url })
194
+
|> Jsont.Object.mem "id" Jsont.int ~enc:(fun _ -> 0)
195
+
|> Jsont.Object.mem "username" Jsont.string ~dec_absent:"" ~enc:(fun u ->
196
+
u.login)
197
+
|> Jsont.Object.mem "email" Jsont.string ~dec_absent:"" ~enc:(fun u ->
198
+
u.email)
199
+
|> Jsont.Object.mem "name" Jsont.string ~dec_absent:"" ~enc:(fun u -> u.name)
200
+
|> Jsont.Object.mem "avatar_url" Jsont.string ~dec_absent:"" ~enc:(fun u ->
201
+
u.avatar_url)
202
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
203
+
204
+
(* Custom: uid extracted from the configured uid_field *)
205
+
let custom_userinfo_jsont ~uid_field =
206
+
Jsont.Object.map ~kind:"custom_userinfo" (fun uid email name ->
207
+
{ uid; login = ""; email; name; avatar_url = "" })
208
+
|> Jsont.Object.mem uid_field Jsont.string ~enc:(fun u -> u.uid)
209
+
|> Jsont.Object.mem "email" Jsont.string ~dec_absent:"" ~enc:(fun u ->
210
+
u.email)
211
+
|> Jsont.Object.mem "name" Jsont.string ~dec_absent:"" ~enc:(fun u -> u.name)
212
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
213
+
214
+
let parse_userinfo provider body =
215
+
let jsont =
216
+
match provider with
217
+
| Github -> github_userinfo_jsont
218
+
| Google -> google_userinfo_jsont
219
+
| Gitlab -> gitlab_userinfo_jsont
220
+
| Custom c -> custom_userinfo_jsont ~uid_field:c.uid_field
221
+
in
222
+
match decode jsont body with
223
+
| Error e -> Error (Fmt.str "userinfo parse error: %s" e)
224
+
| Ok u when u.uid = "" ->
225
+
Error
226
+
(Fmt.str "userinfo response from %s has empty uid"
227
+
(provider_name provider))
228
+
| Ok u -> Ok u
+83
-55
lib/oauth.mli
+83
-55
lib/oauth.mli
···
1
1
(** OAuth 2.0 authorization and token exchange.
2
2
3
-
Generic OAuth 2.0 implementation with provider-specific configuration.
4
-
Implements {{:https://datatracker.ietf.org/doc/html/rfc6749} RFC 6749} and
5
-
{{:https://datatracker.ietf.org/doc/html/rfc7636} RFC 7636 (PKCE)}.
3
+
Implements the Authorization Code grant of
4
+
{{:https://datatracker.ietf.org/doc/html/rfc6749} RFC 6749 (OAuth 2.0)}.
5
+
Provides state generation for CSRF protection, authorization URL
6
+
construction, and token exchange/refresh with form-encoded bodies per
7
+
{{:https://datatracker.ietf.org/doc/html/rfc6749#section-4.1.3} RFC 6749
8
+
Section 4.1.3}.
6
9
7
10
{2 Example}
8
11
9
12
{[
10
-
(* GitHub OAuth *)
11
13
let state = Oauth.generate_state () in
12
14
let url =
13
-
Oauth.authorization_url Oauth.Github.provider ~client_id:"xxx"
15
+
Oauth.authorization_url Github ~client_id:"xxx"
14
16
~redirect_uri:"https://app.com/callback" ~state
15
17
~scope:[ "user:email" ]
16
18
in
19
+
(* redirect user to [url] *)
17
20
18
-
(* After callback, exchange code for token *)
21
+
(* On callback, exchange code for token *)
19
22
let body =
20
-
Oauth.exchange_request_body ~client_id:"xxx" ~client_secret:"yyy"
23
+
Oauth.exchange_form_body ~client_id:"xxx" ~client_secret:"yyy"
21
24
~code ~redirect_uri:"https://app.com/callback"
22
25
in
23
-
(* POST body to (Oauth.Github.provider).token_url with
26
+
(* POST [body] to [Oauth.token_url Github] with
27
+
Content-Type: application/x-www-form-urlencoded
24
28
Accept: application/json *)
25
29
]} *)
26
30
27
-
(** {1 Provider Configuration} *)
31
+
(** {1:providers Providers} *)
32
+
33
+
(** Supported OAuth providers. The variant determines which endpoints are used
34
+
and how the userinfo response is parsed. *)
35
+
type provider =
36
+
| Github
37
+
(** {{:https://docs.github.com/en/apps/oauth-apps} GitHub OAuth}.
38
+
Userinfo: [id] (int), [login], [email], [name], [avatar_url]. *)
39
+
| Google
40
+
(** {{:https://developers.google.com/identity/protocols/oauth2} Google
41
+
OAuth / OIDC}. Userinfo: [sub] (string), [email], [name], [picture].
42
+
*)
43
+
| Gitlab
44
+
(** {{:https://docs.gitlab.com/ee/api/oauth2.html} GitLab OAuth}.
45
+
Userinfo: [id] (int), [username], [email], [name], [avatar_url]. *)
46
+
| Custom of custom_provider (** A custom OAuth 2.0 provider. *)
28
47
29
-
type provider = {
30
-
name : string; (** Provider name, e.g. "github", "google". *)
48
+
and custom_provider = {
49
+
name : string;
31
50
authorize_url : string;
32
-
(** Authorization endpoint, e.g.
33
-
[https://github.com/login/oauth/authorize]. *)
34
51
token_url : string;
35
-
(** Token exchange endpoint, e.g.
36
-
[https://github.com/login/oauth/access_token]. *)
37
52
userinfo_url : string;
38
-
(** User profile endpoint, e.g. [https://api.github.com/user]. *)
53
+
uid_field : string; (** JSON field containing the unique user identifier. *)
39
54
}
40
-
(** OAuth 2.0 provider endpoints. *)
55
+
(** Configuration for a custom OAuth provider not covered by the built-in
56
+
variants. *)
41
57
42
-
(** {1 State Generation} *)
58
+
val provider_name : provider -> string
59
+
(** [provider_name p] is the lowercase name (["github"], ["google"], ["gitlab"],
60
+
or the custom name). *)
61
+
62
+
val authorize_url : provider -> string
63
+
(** [authorize_url p] is the authorization endpoint URL. *)
64
+
65
+
val token_url : provider -> string
66
+
(** [token_url p] is the token exchange endpoint URL. *)
67
+
68
+
val userinfo_url : provider -> string
69
+
(** [userinfo_url p] is the user profile endpoint URL. *)
70
+
71
+
val default_scope : provider -> string list
72
+
(** [default_scope p] is the default OAuth scope for the provider.
73
+
[["user:email"]] for GitHub, [["openid"; "email"; "profile"]] for Google,
74
+
[["read_user"]] for GitLab, [[]] for custom. *)
75
+
76
+
(** {1:state State Generation} *)
43
77
44
78
val generate_state : unit -> string
45
-
(** [generate_state ()] generates a cryptographically secure random state for
46
-
CSRF protection. Returns a 64-character lowercase hex string (32 random
47
-
bytes).
79
+
(** [generate_state ()] is a 64-character lowercase hex string (32 random bytes)
80
+
suitable as the [state] parameter for CSRF protection.
48
81
49
-
@raise Crypto_rng.Unseeded_generator if RNG not initialized. *)
82
+
@raise Crypto_rng.Unseeded_generator if the RNG is not initialized. *)
50
83
51
-
(** {1 Authorization URL} *)
84
+
(** {1:authz Authorization URL} *)
52
85
53
86
val authorization_url :
54
87
provider ->
···
57
90
state:string ->
58
91
scope:string list ->
59
92
string
60
-
(** [authorization_url provider ~client_id ~redirect_uri ~state ~scope]
61
-
generates an OAuth authorization URL for the given provider.
93
+
(** [authorization_url provider ~client_id ~redirect_uri ~state ~scope] is an
94
+
authorization URL for the given provider. Scopes are space-joined per RFC
95
+
6749. An empty [scope] list omits the parameter. *)
62
96
63
-
@param scope
64
-
List of requested scopes (space-joined per RFC 6749). Empty list omits the
65
-
scope parameter. *)
66
-
67
-
(** {1 Token Exchange} *)
97
+
(** {1:exchange Token Exchange} *)
68
98
69
99
val exchange_form_body :
70
100
client_id:string ->
···
72
102
code:string ->
73
103
redirect_uri:string ->
74
104
string
75
-
(** [exchange_form_body ~client_id ~client_secret ~code ~redirect_uri] returns a
105
+
(** [exchange_form_body ~client_id ~client_secret ~code ~redirect_uri] is an
76
106
[application/x-www-form-urlencoded] string for exchanging an authorization
77
-
code for an access token (RFC 6749 §4.1.3).
107
+
code for an access token (RFC 6749 §4.1.3). *)
78
108
79
-
POST this to [provider.token_url] with
80
-
[Content-Type: application/x-www-form-urlencoded]. *)
81
-
82
-
(** {1 Token Response} *)
109
+
(** {1:token Token Response} *)
83
110
84
111
type token_response = {
85
112
access_token : string;
86
113
expires_in : int option;
87
-
(** Seconds until expiry. [None] if the token does not expire. *)
88
114
refresh_token : string option;
89
115
refresh_token_expires_in : int option;
90
116
}
91
-
(** Token response. Supports providers that return refresh tokens and expiry
92
-
(e.g. GitHub Apps) and those that don't (e.g. GitHub OAuth Apps). *)
117
+
(** Parsed token response. *)
93
118
94
119
type parse_token_error =
95
120
| Invalid_json
···
97
122
| Invalid_token_format
98
123
99
124
val parse_token_response : string -> (token_response, parse_token_error) result
100
-
(** [parse_token_response body] parses an OAuth token response JSON. *)
125
+
(** [parse_token_response body] parses a JSON token response. *)
101
126
102
127
val pp_parse_token_error : Format.formatter -> parse_token_error -> unit
103
128
104
-
(** {1 Token Refresh} *)
129
+
(** {1:refresh Token Refresh} *)
105
130
106
131
val refresh_form_body :
107
132
client_id:string -> client_secret:string -> refresh_token:string -> string
108
-
(** [refresh_form_body ~client_id ~client_secret ~refresh_token] returns a
133
+
(** [refresh_form_body ~client_id ~client_secret ~refresh_token] is a
109
134
form-encoded string for refreshing an access token (RFC 6749 §6). *)
110
135
111
-
(** {1 Providers} *)
136
+
(** {1:userinfo Userinfo Parsing} *)
112
137
113
-
module Github : sig
114
-
val provider : provider
115
-
(** GitHub OAuth provider ([github.com/login/oauth/...]). *)
116
-
end
138
+
type userinfo = {
139
+
uid : string; (** Provider-specific unique identifier. *)
140
+
login : string; (** Username or login handle. *)
141
+
email : string; (** Email address (may be empty). *)
142
+
name : string; (** Display name (may be empty). *)
143
+
avatar_url : string; (** Avatar URL (may be empty). *)
144
+
}
145
+
(** Parsed userinfo from a provider's user profile endpoint.
117
146
118
-
module Google : sig
119
-
val provider : provider
120
-
(** Google OAuth provider ([accounts.google.com/o/oauth2/...]). *)
121
-
end
147
+
The [uid] is guaranteed non-empty when parsing succeeds. *)
148
+
149
+
val parse_userinfo : provider -> string -> (userinfo, string) result
150
+
(** [parse_userinfo provider body] parses a JSON userinfo response using the
151
+
field mapping for [provider].
122
152
123
-
module Gitlab : sig
124
-
val provider : provider
125
-
(** GitLab OAuth provider ([gitlab.com/oauth/...]). *)
126
-
end
153
+
Returns [Error msg] if the JSON is invalid or the unique identifier field is
154
+
missing or empty. *)
+4
-4
test/test_github_oauth.ml
+4
-4
test/test_github_oauth.ml
···
25
25
26
26
let test_authorization_url_basic () =
27
27
let url =
28
-
Oauth.authorization_url Oauth.Github.provider ~client_id:"test_client"
28
+
Oauth.authorization_url Oauth.Github ~client_id:"test_client"
29
29
~redirect_uri:"https://example.com/callback" ~state:"test_state"
30
30
~scope:[ "repo" ]
31
31
in
···
44
44
45
45
let test_authorization_url_no_scope () =
46
46
let url =
47
-
Oauth.authorization_url Oauth.Github.provider ~client_id:"test_client"
47
+
Oauth.authorization_url Oauth.Github ~client_id:"test_client"
48
48
~redirect_uri:"https://example.com/callback" ~state:"test_state" ~scope:[]
49
49
in
50
50
Alcotest.(check bool)
···
53
53
54
54
let test_authorization_url_multiple_scopes () =
55
55
let url =
56
-
Oauth.authorization_url Oauth.Github.provider ~client_id:"test_client"
56
+
Oauth.authorization_url Oauth.Github ~client_id:"test_client"
57
57
~redirect_uri:"https://example.com/callback" ~state:"test_state"
58
58
~scope:[ "repo"; "user"; "read:org" ]
59
59
in
···
63
63
64
64
let test_authorization_url_google () =
65
65
let url =
66
-
Oauth.authorization_url Oauth.Google.provider ~client_id:"test_client"
66
+
Oauth.authorization_url Oauth.Google ~client_id:"test_client"
67
67
~redirect_uri:"https://example.com/callback" ~state:"test_state"
68
68
~scope:[ "openid"; "email" ]
69
69
in
+1
-1
test/test_regressions.ml
+1
-1
test/test_regressions.ml
···
22
22
23
23
let test_authorization_url_includes_response_type_code () =
24
24
let url =
25
-
Oauth.authorization_url Oauth.Github.provider ~client_id:"test_client"
25
+
Oauth.authorization_url Oauth.Github ~client_id:"test_client"
26
26
~redirect_uri:"https://example.com/callback" ~state:"test_state"
27
27
~scope:[ "repo" ]
28
28
in