OAuth 2.0 authorization and token exchange
Fix 5 auth/oauth/sqlite security bugs
1. Sqlite: silent data loss on corrupt DB — Store.v caught all exceptions
and fell back to Sqlite.v (which truncates). Now only catches Eio.Io
(file not found). Remove Sqlite.v; add Sqlite.open_ ~create flag.
2. Sign-out: now revokes server-side session via Store.delete_session.
Previously only cleared the browser cookie — copied sid stayed valid.
Changed to POST /auth/signout with header-based session lookup.
3. OAuth: authorization URL now includes response_type=code per RFC 6749.
4. OAuth: token exchange/refresh now uses application/x-www-form-urlencoded
per RFC 6749, not JSON. Removed JSON-body functions, added form_encode
helper and exchange_form_body/refresh_form_body returning strings.
5. Auth: callback now uses provider.userinfo_url instead of hardcoded
GitHub API. Added userinfo_url to Oauth.provider type. Google, GitLab,
and custom providers can now complete login.
+888
+17
.gitignore
+17
.gitignore
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version = 0.28.1
+21
LICENSE.md
+21
LICENSE.md
···
1
+
MIT License
2
+
3
+
Copyright (c) 2025 Thomas Gazagnaire
4
+
5
+
Permission is hereby granted, free of charge, to any person obtaining a copy
6
+
of this software and associated documentation files (the "Software"), to deal
7
+
in the Software without restriction, including without limitation the rights
8
+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9
+
copies of the Software, and to permit persons to whom the Software is
10
+
furnished to do so, subject to the following conditions:
11
+
12
+
The above copyright notice and this permission notice shall be included in all
13
+
copies or substantial portions of the Software.
14
+
15
+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16
+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17
+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18
+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19
+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20
+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21
+
SOFTWARE.
+77
README.md
+77
README.md
···
1
+
# github-oauth
2
+
3
+
GitHub OAuth URL generation and token exchange helpers for OCaml.
4
+
5
+
## Overview
6
+
7
+
This library provides helpers for implementing GitHub OAuth 2.0 authorization flows. It supports both GitHub Apps (with token expiry and refresh tokens) and traditional OAuth Apps.
8
+
9
+
## Features
10
+
11
+
- Cryptographically secure state generation for CSRF protection
12
+
- Authorization URL generation with scope support
13
+
- Token exchange request body generation (JSON)
14
+
- Token response parsing (access tokens, refresh tokens, expiry)
15
+
- Refresh token request body generation
16
+
17
+
## Installation
18
+
19
+
```
20
+
opam install oauth
21
+
```
22
+
23
+
## Usage
24
+
25
+
```ocaml
26
+
(* Generate authorization URL *)
27
+
let state = Github_oauth.generate_state () in
28
+
let url =
29
+
Github_oauth.authorization_url ~client_id:"your_client_id"
30
+
~callback_url:"https://yourapp.com/callback" ~state ~scope:[ "repo" ]
31
+
in
32
+
33
+
(* After user authorizes, exchange code for token *)
34
+
let body =
35
+
Github_oauth.exchange_request_body ~client_id:"your_client_id"
36
+
~client_secret:"your_secret" ~code ~redirect_uri:"https://yourapp.com/callback"
37
+
in
38
+
(* POST body to Github_oauth.access_token_url with headers:
39
+
Content-Type: application/json
40
+
Accept: application/json *)
41
+
42
+
(* Parse the response *)
43
+
match Github_oauth.parse_token_response response_body with
44
+
| Ok token ->
45
+
Printf.printf "Access token: %s\n" token.access_token;
46
+
(* For GitHub Apps, handle refresh *)
47
+
(match token.refresh_token with
48
+
| Some rt -> (* store for later refresh *)
49
+
| None -> (* OAuth App, no refresh needed *))
50
+
| Error e ->
51
+
Printf.eprintf "Error: %a\n" Github_oauth.pp_parse_token_error e
52
+
```
53
+
54
+
## API
55
+
56
+
- `Github_oauth.generate_state` - Generate CSRF protection state
57
+
- `Github_oauth.authorization_url` - Build GitHub authorization URL
58
+
- `Github_oauth.access_token_url` - Token exchange endpoint URL
59
+
- `Github_oauth.exchange_request_body` - Build token exchange request
60
+
- `Github_oauth.parse_token_response` - Parse token response JSON
61
+
- `Github_oauth.refresh_request_body` - Build refresh token request
62
+
63
+
## Standards
64
+
65
+
- [RFC 6749](https://datatracker.ietf.org/doc/html/rfc6749) - OAuth 2.0
66
+
- [GitHub OAuth Documentation](https://docs.github.com/en/apps/oauth-apps/building-oauth-apps/authorizing-oauth-apps)
67
+
68
+
## Related Work
69
+
70
+
- [github-oauth2](https://github.com/tmattio/ocaml-github-oauth2) - Full OAuth2 client with HTTP handling
71
+
- [oauth2](https://opam.ocaml.org/packages/oauth2/) - Generic OAuth2 library
72
+
73
+
This library focuses on URL and request body generation without HTTP dependencies, allowing integration with any HTTP client (Cohttp, Dream, Eio, etc.).
74
+
75
+
## Licence
76
+
77
+
MIT License. See [LICENSE.md](LICENSE.md) for details.
+27
dune-project
+27
dune-project
···
1
+
(lang dune 3.21)
2
+
(name oauth)
3
+
4
+
(generate_opam_files true)
5
+
6
+
(source (tangled gazagnaire.org/ocaml-oauth))
7
+
(license MIT)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
11
+
(package
12
+
(name oauth)
13
+
(synopsis "OAuth 2.0 authorization and token exchange")
14
+
(description "Generic OAuth 2.0 implementation with provider configuration. Supports GitHub, Google, GitLab, and custom providers. Implements RFC 6749 (OAuth 2.0) and RFC 7636 (PKCE).")
15
+
(depends
16
+
(ocaml (>= 4.08))
17
+
(dune (>= 3.21))
18
+
(fmt (>= 0.9))
19
+
(uri (>= 4.0))
20
+
(jsont (>= 0.1.0))
21
+
(bytesrw (>= 0.1.0))
22
+
(crypto-rng (>= 0.11.0))
23
+
(ohex (>= 0.2))
24
+
(logs (>= 0.7))
25
+
(alcotest :with-test)
26
+
(crowbar :with-test)
27
+
(odoc :with-doc)))
+27
fuzz/dune
+27
fuzz/dune
···
1
+
; Crowbar fuzz testing for oauth
2
+
;
3
+
; Quick check: dune build @fuzz
4
+
; With AFL: crow start --cpus=4
5
+
6
+
(executable
7
+
(name fuzz)
8
+
(modules fuzz fuzz_github_oauth)
9
+
(libraries oauth alcobar crypto-rng.unix))
10
+
11
+
(rule
12
+
(alias runtest)
13
+
(enabled_if
14
+
(<> %{profile} afl))
15
+
(deps fuzz.exe)
16
+
(action
17
+
(run %{exe:fuzz.exe})))
18
+
19
+
(rule
20
+
(alias fuzz)
21
+
(enabled_if
22
+
(= %{profile} afl))
23
+
(deps
24
+
(source_tree corpus)
25
+
fuzz.exe)
26
+
(action
27
+
(echo "AFL fuzzer built: %{exe:fuzz.exe}\n")))
+1
fuzz/fuzz.ml
+1
fuzz/fuzz.ml
···
1
+
let () = Alcobar.run "oauth" [ Fuzz_github_oauth.suite ]
+72
fuzz/fuzz_github_oauth.ml
+72
fuzz/fuzz_github_oauth.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Alcobar
7
+
8
+
let () = Crypto_rng_unix.use_default ()
9
+
10
+
(* Test that authorization_url always produces valid URLs *)
11
+
let test_authorization_url_valid client_id redirect_uri state scope =
12
+
let url =
13
+
Oauth.authorization_url Oauth.Github.provider ~client_id ~redirect_uri
14
+
~state ~scope
15
+
in
16
+
check (String.length url > 0);
17
+
check (String.sub url 0 8 = "https://")
18
+
19
+
(* Test that exchange_form_body produces valid form-encoded body *)
20
+
let test_exchange_body_valid client_id client_secret code redirect_uri =
21
+
let body =
22
+
Oauth.exchange_form_body ~client_id ~client_secret ~code ~redirect_uri
23
+
in
24
+
check (String.length body > 0);
25
+
check (String.contains body '=')
26
+
27
+
(* Test that refresh_form_body produces valid form-encoded body *)
28
+
let test_refresh_body_valid client_id client_secret refresh_token =
29
+
let body = Oauth.refresh_form_body ~client_id ~client_secret ~refresh_token in
30
+
check (String.length body > 0);
31
+
check (String.contains body '=')
32
+
33
+
(* Test that parse_token_response handles arbitrary input without crashing *)
34
+
let test_parse_no_crash input =
35
+
let _ = Oauth.parse_token_response input in
36
+
check true
37
+
38
+
(* Test roundtrip: encode a valid token response, then parse it *)
39
+
let test_token_roundtrip access_token expires_in refresh_token =
40
+
let json =
41
+
let parts =
42
+
[ Fmt.str {|"access_token":"%s"|} access_token ]
43
+
@ (match expires_in with
44
+
| None -> []
45
+
| Some n -> [ Fmt.str {|"expires_in":%d|} (abs n mod 100000) ])
46
+
@
47
+
match refresh_token with
48
+
| None -> []
49
+
| Some rt -> [ Fmt.str {|"refresh_token":"%s"|} rt ]
50
+
in
51
+
"{" ^ String.concat "," parts ^ "}"
52
+
in
53
+
match Oauth.parse_token_response json with
54
+
| Ok t -> check (t.access_token = access_token)
55
+
| Error _ -> check true
56
+
57
+
let suite =
58
+
( "oauth",
59
+
[
60
+
test_case "authorization_url valid"
61
+
[ bytes; bytes; bytes; list bytes ]
62
+
test_authorization_url_valid;
63
+
test_case "exchange_body valid"
64
+
[ bytes; bytes; bytes; bytes ]
65
+
test_exchange_body_valid;
66
+
test_case "refresh_body valid" [ bytes; bytes; bytes ]
67
+
test_refresh_body_valid;
68
+
test_case "parse_no_crash" [ bytes ] test_parse_no_crash;
69
+
test_case "token roundtrip"
70
+
[ bytes; option int; option bytes ]
71
+
test_token_roundtrip;
72
+
] )
+4
fuzz/fuzz_github_oauth.mli
+4
fuzz/fuzz_github_oauth.mli
+1
fuzz/input/callback_url
+1
fuzz/input/callback_url
···
1
+
https://example.com/callback
+1
fuzz/input/client_id
+1
fuzz/input/client_id
···
1
+
client_id_abc123
fuzz/input/empty
fuzz/input/empty
This is a binary file and will not be displayed.
+4
lib/dune
+4
lib/dune
+172
lib/oauth.ml
+172
lib/oauth.ml
···
1
+
(** OAuth 2.0 authorization and token exchange. *)
2
+
3
+
let src = Logs.Src.create "oauth" ~doc:"OAuth 2.0 helpers"
4
+
5
+
module Log = (val Logs.src_log src : Logs.LOG)
6
+
7
+
(* {1 Provider} *)
8
+
9
+
type provider = {
10
+
name : string;
11
+
authorize_url : string;
12
+
token_url : string;
13
+
userinfo_url : string;
14
+
}
15
+
16
+
(* {1 JSON helpers} *)
17
+
18
+
let decode codec s = Jsont_bytesrw.decode_string codec s
19
+
20
+
let encode codec v =
21
+
Jsont_bytesrw.encode_string codec v |> Result.value ~default:"{}"
22
+
23
+
(* {1 State} *)
24
+
25
+
let generate_state () = Ohex.encode (Crypto_rng.generate 32)
26
+
27
+
(* {1 Authorization URL} *)
28
+
29
+
let authorization_url provider ~client_id ~redirect_uri ~state ~scope =
30
+
let uri = Uri.of_string provider.authorize_url in
31
+
let base_query =
32
+
[
33
+
("response_type", [ "code" ]);
34
+
("client_id", [ client_id ]);
35
+
("redirect_uri", [ redirect_uri ]);
36
+
("state", [ state ]);
37
+
]
38
+
in
39
+
let query =
40
+
match scope with
41
+
| [] -> base_query
42
+
| lst -> ("scope", [ String.concat " " lst ]) :: base_query
43
+
in
44
+
Uri.with_query uri query |> Uri.to_string
45
+
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
57
+
58
+
let pct_encode s =
59
+
let buf = Buffer.create (String.length s) in
60
+
String.iter
61
+
(fun c ->
62
+
match c with
63
+
| 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '-' | '_' | '.' | '~' ->
64
+
Buffer.add_char buf c
65
+
| _ -> Buffer.add_string buf (Fmt.str "%%%02X" (Char.code c)))
66
+
s;
67
+
Buffer.contents buf
68
+
69
+
let form_encode params =
70
+
String.concat "&"
71
+
(List.map (fun (k, v) -> pct_encode k ^ "=" ^ pct_encode v) params)
72
+
73
+
let exchange_form_body ~client_id ~client_secret ~code ~redirect_uri =
74
+
form_encode
75
+
[
76
+
("grant_type", "authorization_code");
77
+
("client_id", client_id);
78
+
("client_secret", client_secret);
79
+
("code", code);
80
+
("redirect_uri", redirect_uri);
81
+
]
82
+
83
+
(* {1 Token Response} *)
84
+
85
+
type token_response = {
86
+
access_token : string;
87
+
expires_in : int option;
88
+
refresh_token : string option;
89
+
refresh_token_expires_in : int option;
90
+
}
91
+
92
+
let token_response_jsont =
93
+
Jsont.Object.map ~kind:"token_response"
94
+
(fun access_token expires_in refresh_token refresh_token_expires_in ->
95
+
{ access_token; expires_in; refresh_token; refresh_token_expires_in })
96
+
|> Jsont.Object.mem "access_token" Jsont.string ~enc:(fun t -> t.access_token)
97
+
|> Jsont.Object.opt_mem "expires_in" Jsont.int ~enc:(fun t -> t.expires_in)
98
+
|> Jsont.Object.opt_mem "refresh_token" Jsont.string ~enc:(fun t ->
99
+
t.refresh_token)
100
+
|> Jsont.Object.opt_mem "refresh_token_expires_in" Jsont.int ~enc:(fun t ->
101
+
t.refresh_token_expires_in)
102
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
103
+
104
+
type parse_token_error =
105
+
| Invalid_json
106
+
| Missing_access_token
107
+
| Invalid_token_format
108
+
109
+
let pp_parse_token_error fmt = function
110
+
| Invalid_json -> Fmt.pf fmt "Invalid JSON"
111
+
| Missing_access_token -> Fmt.pf fmt "Missing access_token field"
112
+
| Invalid_token_format -> Fmt.pf fmt "Invalid token format"
113
+
114
+
let parse_token_response body =
115
+
match decode token_response_jsont body with
116
+
| Ok t -> Ok t
117
+
| Error e ->
118
+
Log.warn (fun m -> m "Token parse failed: %s" e);
119
+
Error Invalid_json
120
+
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
132
+
133
+
let refresh_form_body ~client_id ~client_secret ~refresh_token =
134
+
form_encode
135
+
[
136
+
("grant_type", "refresh_token");
137
+
("client_id", client_id);
138
+
("client_secret", client_secret);
139
+
("refresh_token", refresh_token);
140
+
]
141
+
142
+
(* {1 Providers} *)
143
+
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
153
+
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
163
+
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
+126
lib/oauth.mli
+126
lib/oauth.mli
···
1
+
(** OAuth 2.0 authorization and token exchange.
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)}.
6
+
7
+
{2 Example}
8
+
9
+
{[
10
+
(* GitHub OAuth *)
11
+
let state = Oauth.generate_state () in
12
+
let url =
13
+
Oauth.authorization_url Oauth.Github.provider ~client_id:"xxx"
14
+
~redirect_uri:"https://app.com/callback" ~state
15
+
~scope:[ "user:email" ]
16
+
in
17
+
18
+
(* After callback, exchange code for token *)
19
+
let body =
20
+
Oauth.exchange_request_body ~client_id:"xxx" ~client_secret:"yyy"
21
+
~code ~redirect_uri:"https://app.com/callback"
22
+
in
23
+
(* POST body to (Oauth.Github.provider).token_url with
24
+
Accept: application/json *)
25
+
]} *)
26
+
27
+
(** {1 Provider Configuration} *)
28
+
29
+
type provider = {
30
+
name : string; (** Provider name, e.g. "github", "google". *)
31
+
authorize_url : string;
32
+
(** Authorization endpoint, e.g.
33
+
[https://github.com/login/oauth/authorize]. *)
34
+
token_url : string;
35
+
(** Token exchange endpoint, e.g.
36
+
[https://github.com/login/oauth/access_token]. *)
37
+
userinfo_url : string;
38
+
(** User profile endpoint, e.g. [https://api.github.com/user]. *)
39
+
}
40
+
(** OAuth 2.0 provider endpoints. *)
41
+
42
+
(** {1 State Generation} *)
43
+
44
+
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).
48
+
49
+
@raise Crypto_rng.Unseeded_generator if RNG not initialized. *)
50
+
51
+
(** {1 Authorization URL} *)
52
+
53
+
val authorization_url :
54
+
provider ->
55
+
client_id:string ->
56
+
redirect_uri:string ->
57
+
state:string ->
58
+
scope:string list ->
59
+
string
60
+
(** [authorization_url provider ~client_id ~redirect_uri ~state ~scope]
61
+
generates an OAuth authorization URL for the given provider.
62
+
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} *)
68
+
69
+
val exchange_form_body :
70
+
client_id:string ->
71
+
client_secret:string ->
72
+
code:string ->
73
+
redirect_uri:string ->
74
+
string
75
+
(** [exchange_form_body ~client_id ~client_secret ~code ~redirect_uri] returns a
76
+
[application/x-www-form-urlencoded] string for exchanging an authorization
77
+
code for an access token (RFC 6749 §4.1.3).
78
+
79
+
POST this to [provider.token_url] with
80
+
[Content-Type: application/x-www-form-urlencoded]. *)
81
+
82
+
(** {1 Token Response} *)
83
+
84
+
type token_response = {
85
+
access_token : string;
86
+
expires_in : int option;
87
+
(** Seconds until expiry. [None] if the token does not expire. *)
88
+
refresh_token : string option;
89
+
refresh_token_expires_in : int option;
90
+
}
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). *)
93
+
94
+
type parse_token_error =
95
+
| Invalid_json
96
+
| Missing_access_token
97
+
| Invalid_token_format
98
+
99
+
val parse_token_response : string -> (token_response, parse_token_error) result
100
+
(** [parse_token_response body] parses an OAuth token response JSON. *)
101
+
102
+
val pp_parse_token_error : Format.formatter -> parse_token_error -> unit
103
+
104
+
(** {1 Token Refresh} *)
105
+
106
+
val refresh_form_body :
107
+
client_id:string -> client_secret:string -> refresh_token:string -> string
108
+
(** [refresh_form_body ~client_id ~client_secret ~refresh_token] returns a
109
+
form-encoded string for refreshing an access token (RFC 6749 §6). *)
110
+
111
+
(** {1 Providers} *)
112
+
113
+
module Github : sig
114
+
val provider : provider
115
+
(** GitHub OAuth provider ([github.com/login/oauth/...]). *)
116
+
end
117
+
118
+
module Google : sig
119
+
val provider : provider
120
+
(** Google OAuth provider ([accounts.google.com/o/oauth2/...]). *)
121
+
end
122
+
123
+
module Gitlab : sig
124
+
val provider : provider
125
+
(** GitLab OAuth provider ([gitlab.com/oauth/...]). *)
126
+
end
+40
oauth.opam
+40
oauth.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "OAuth 2.0 authorization and token exchange"
4
+
description:
5
+
"Generic OAuth 2.0 implementation with provider configuration. Supports GitHub, Google, GitLab, and custom providers. Implements RFC 6749 (OAuth 2.0) and RFC 7636 (PKCE)."
6
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
7
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
license: "MIT"
9
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-oauth"
10
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-oauth/issues"
11
+
depends: [
12
+
"ocaml" {>= "4.08"}
13
+
"dune" {>= "3.21" & >= "3.21"}
14
+
"fmt" {>= "0.9"}
15
+
"uri" {>= "4.0"}
16
+
"jsont" {>= "0.1.0"}
17
+
"bytesrw" {>= "0.1.0"}
18
+
"crypto-rng" {>= "0.11.0"}
19
+
"ohex" {>= "0.2"}
20
+
"logs" {>= "0.7"}
21
+
"alcotest" {with-test}
22
+
"crowbar" {with-test}
23
+
"odoc" {with-doc}
24
+
]
25
+
build: [
26
+
["dune" "subst"] {dev}
27
+
[
28
+
"dune"
29
+
"build"
30
+
"-p"
31
+
name
32
+
"-j"
33
+
jobs
34
+
"@install"
35
+
"@runtest" {with-test}
36
+
"@doc" {with-doc}
37
+
]
38
+
]
39
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-oauth"
40
+
x-maintenance-intent: ["(latest)"]
+4
test/dune
+4
test/dune
+3
test/test.ml
+3
test/test.ml
+175
test/test_github_oauth.ml
+175
test/test_github_oauth.ml
···
1
+
(* Tests for Oauth *)
2
+
3
+
let is_substring str ~substring =
4
+
let len = String.length substring in
5
+
let rec check i =
6
+
if i + len > String.length str then false
7
+
else if String.sub str i len = substring then true
8
+
else check (i + 1)
9
+
in
10
+
check 0
11
+
12
+
let test_generate_state () =
13
+
let state = Oauth.generate_state () in
14
+
Alcotest.(check int) "state length is 64" 64 (String.length state);
15
+
String.iter
16
+
(fun c ->
17
+
let is_hex = (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') in
18
+
Alcotest.(check bool) "is hex char" true is_hex)
19
+
state
20
+
21
+
let test_generate_state_unique () =
22
+
let state1 = Oauth.generate_state () in
23
+
let state2 = Oauth.generate_state () in
24
+
Alcotest.(check bool) "states are different" true (state1 <> state2)
25
+
26
+
let test_authorization_url_basic () =
27
+
let url =
28
+
Oauth.authorization_url Oauth.Github.provider ~client_id:"test_client"
29
+
~redirect_uri:"https://example.com/callback" ~state:"test_state"
30
+
~scope:[ "repo" ]
31
+
in
32
+
Alcotest.(check bool)
33
+
"contains github.com" true
34
+
(String.sub url 0 24 = "https://github.com/login");
35
+
Alcotest.(check bool)
36
+
"contains client_id" true
37
+
(is_substring url ~substring:"client_id=test_client");
38
+
Alcotest.(check bool)
39
+
"contains state" true
40
+
(is_substring url ~substring:"state=test_state");
41
+
Alcotest.(check bool)
42
+
"contains scope" true
43
+
(is_substring url ~substring:"scope=repo")
44
+
45
+
let test_authorization_url_no_scope () =
46
+
let url =
47
+
Oauth.authorization_url Oauth.Github.provider ~client_id:"test_client"
48
+
~redirect_uri:"https://example.com/callback" ~state:"test_state" ~scope:[]
49
+
in
50
+
Alcotest.(check bool)
51
+
"no scope param" true
52
+
(not (is_substring url ~substring:"scope="))
53
+
54
+
let test_authorization_url_multiple_scopes () =
55
+
let url =
56
+
Oauth.authorization_url Oauth.Github.provider ~client_id:"test_client"
57
+
~redirect_uri:"https://example.com/callback" ~state:"test_state"
58
+
~scope:[ "repo"; "user"; "read:org" ]
59
+
in
60
+
Alcotest.(check bool)
61
+
"contains scope" true
62
+
(is_substring url ~substring:"scope=")
63
+
64
+
let test_authorization_url_google () =
65
+
let url =
66
+
Oauth.authorization_url Oauth.Google.provider ~client_id:"test_client"
67
+
~redirect_uri:"https://example.com/callback" ~state:"test_state"
68
+
~scope:[ "openid"; "email" ]
69
+
in
70
+
Alcotest.(check bool)
71
+
"contains google.com" true
72
+
(is_substring url ~substring:"accounts.google.com")
73
+
74
+
let test_exchange_request_body () =
75
+
let body =
76
+
Oauth.exchange_form_body ~client_id:"test_client"
77
+
~client_secret:"test_secret" ~code:"auth_code"
78
+
~redirect_uri:"https://example.com/callback"
79
+
in
80
+
Alcotest.(check bool)
81
+
"contains client_id" true
82
+
(is_substring body ~substring:"client_id=");
83
+
Alcotest.(check bool)
84
+
"contains client_secret" true
85
+
(is_substring body ~substring:"client_secret=");
86
+
Alcotest.(check bool)
87
+
"contains code" true
88
+
(is_substring body ~substring:"code=");
89
+
Alcotest.(check bool)
90
+
"contains redirect_uri" true
91
+
(is_substring body ~substring:"redirect_uri=")
92
+
93
+
let test_parse_token_oauth_app () =
94
+
let json = {|{"access_token":"gho_abc123"}|} in
95
+
match Oauth.parse_token_response json with
96
+
| Ok t ->
97
+
Alcotest.(check string) "access_token" "gho_abc123" t.access_token;
98
+
Alcotest.(check (option int)) "no expires_in" None t.expires_in;
99
+
Alcotest.(check (option string)) "no refresh_token" None t.refresh_token
100
+
| Error e ->
101
+
Alcotest.fail (Fmt.str "parse failed: %a" Oauth.pp_parse_token_error e)
102
+
103
+
let test_parse_token_github_app () =
104
+
let json =
105
+
{|{"access_token":"ghu_abc123","expires_in":28800,"refresh_token":"ghr_xyz789","refresh_token_expires_in":15897600}|}
106
+
in
107
+
match Oauth.parse_token_response json with
108
+
| Ok t ->
109
+
Alcotest.(check string) "access_token" "ghu_abc123" t.access_token;
110
+
Alcotest.(check (option int)) "expires_in" (Some 28800) t.expires_in;
111
+
Alcotest.(check (option string))
112
+
"refresh_token" (Some "ghr_xyz789") t.refresh_token;
113
+
Alcotest.(check (option int))
114
+
"refresh_token_expires_in" (Some 15897600) t.refresh_token_expires_in
115
+
| Error e ->
116
+
Alcotest.fail (Fmt.str "parse failed: %a" Oauth.pp_parse_token_error e)
117
+
118
+
let test_parse_token_extra_fields () =
119
+
let json =
120
+
{|{"access_token":"gho_test","token_type":"bearer","scope":"repo"}|}
121
+
in
122
+
match Oauth.parse_token_response json with
123
+
| Ok t -> Alcotest.(check string) "access_token" "gho_test" t.access_token
124
+
| Error e ->
125
+
Alcotest.fail (Fmt.str "parse failed: %a" Oauth.pp_parse_token_error e)
126
+
127
+
let test_parse_token_invalid_json () =
128
+
let json = "not json" in
129
+
match Oauth.parse_token_response json with
130
+
| Ok _ -> Alcotest.fail "should have failed"
131
+
| Error e ->
132
+
Alcotest.(check bool) "is Invalid_json" true (e = Oauth.Invalid_json)
133
+
134
+
let test_refresh_request_body () =
135
+
let body =
136
+
Oauth.refresh_form_body ~client_id:"test_client"
137
+
~client_secret:"test_secret" ~refresh_token:"ghr_abc123"
138
+
in
139
+
Alcotest.(check bool)
140
+
"contains client_id" true
141
+
(is_substring body ~substring:"client_id=");
142
+
Alcotest.(check bool)
143
+
"contains grant_type" true
144
+
(is_substring body ~substring:"grant_type=");
145
+
Alcotest.(check bool)
146
+
"contains refresh_token" true
147
+
(is_substring body ~substring:"refresh_token=")
148
+
149
+
let suite =
150
+
( "oauth",
151
+
[
152
+
Alcotest.test_case "generate_state length and format" `Quick
153
+
test_generate_state;
154
+
Alcotest.test_case "generate_state unique" `Quick
155
+
test_generate_state_unique;
156
+
Alcotest.test_case "authorization_url github" `Quick
157
+
test_authorization_url_basic;
158
+
Alcotest.test_case "authorization_url no scope" `Quick
159
+
test_authorization_url_no_scope;
160
+
Alcotest.test_case "authorization_url multiple scopes" `Quick
161
+
test_authorization_url_multiple_scopes;
162
+
Alcotest.test_case "authorization_url google" `Quick
163
+
test_authorization_url_google;
164
+
Alcotest.test_case "exchange request body" `Quick
165
+
test_exchange_request_body;
166
+
Alcotest.test_case "parse_token OAuth App" `Quick
167
+
test_parse_token_oauth_app;
168
+
Alcotest.test_case "parse_token GitHub App" `Quick
169
+
test_parse_token_github_app;
170
+
Alcotest.test_case "parse_token extra fields" `Quick
171
+
test_parse_token_extra_fields;
172
+
Alcotest.test_case "parse_token invalid json" `Quick
173
+
test_parse_token_invalid_json;
174
+
Alcotest.test_case "refresh request body" `Quick test_refresh_request_body;
175
+
] )
+3
test/test_github_oauth.mli
+3
test/test_github_oauth.mli
+112
test/test_regressions.ml
+112
test/test_regressions.ml
···
1
+
let contains str ~substring =
2
+
let len = String.length substring in
3
+
let rec go i =
4
+
if i + len > String.length str then false
5
+
else if String.sub str i len = substring then true
6
+
else go (i + 1)
7
+
in
8
+
go 0
9
+
10
+
let first_existing paths =
11
+
match List.find_opt Sys.file_exists paths with
12
+
| Some path -> path
13
+
| None ->
14
+
Alcotest.fail
15
+
(Fmt.str "missing test fixture, looked for one of: %s"
16
+
(String.concat ", " paths))
17
+
18
+
let read_file paths =
19
+
In_channel.with_open_bin (first_existing paths) In_channel.input_all
20
+
21
+
let query_param name query = List.assoc_opt name query
22
+
23
+
let test_authorization_url_includes_response_type_code () =
24
+
let url =
25
+
Oauth.authorization_url Oauth.Github.provider ~client_id:"test_client"
26
+
~redirect_uri:"https://example.com/callback" ~state:"test_state"
27
+
~scope:[ "repo" ]
28
+
in
29
+
let uri = Uri.of_string url in
30
+
Alcotest.(check (option string))
31
+
"response_type=code" (Some "code")
32
+
(Uri.get_query_param uri "response_type")
33
+
34
+
let test_exchange_request_body_uses_form_encoding () =
35
+
let body =
36
+
Oauth.exchange_form_body ~client_id:"test_client"
37
+
~client_secret:"test_secret" ~code:"auth_code"
38
+
~redirect_uri:"https://example.com/callback"
39
+
in
40
+
let query = Uri.query_of_encoded body in
41
+
Alcotest.(check (option (list string)))
42
+
"grant_type=authorization_code" (Some [ "authorization_code" ])
43
+
(query_param "grant_type" query);
44
+
Alcotest.(check (option (list string)))
45
+
"client_id preserved" (Some [ "test_client" ])
46
+
(query_param "client_id" query);
47
+
Alcotest.(check (option (list string)))
48
+
"client_secret preserved" (Some [ "test_secret" ])
49
+
(query_param "client_secret" query);
50
+
Alcotest.(check (option (list string)))
51
+
"code preserved" (Some [ "auth_code" ]) (query_param "code" query);
52
+
Alcotest.(check (option (list string)))
53
+
"redirect_uri preserved" (Some [ "https://example.com/callback" ])
54
+
(query_param "redirect_uri" query)
55
+
56
+
let test_refresh_request_body_uses_form_encoding () =
57
+
let body =
58
+
Oauth.refresh_form_body ~client_id:"test_client"
59
+
~client_secret:"test_secret" ~refresh_token:"ghr_abc123"
60
+
in
61
+
let query = Uri.query_of_encoded body in
62
+
Alcotest.(check (option (list string)))
63
+
"grant_type=refresh_token" (Some [ "refresh_token" ])
64
+
(query_param "grant_type" query);
65
+
Alcotest.(check (option (list string)))
66
+
"client_id preserved" (Some [ "test_client" ])
67
+
(query_param "client_id" query);
68
+
Alcotest.(check (option (list string)))
69
+
"client_secret preserved" (Some [ "test_secret" ])
70
+
(query_param "client_secret" query);
71
+
Alcotest.(check (option (list string)))
72
+
"refresh_token preserved" (Some [ "ghr_abc123" ])
73
+
(query_param "refresh_token" query)
74
+
75
+
let test_readme_uses_current_api_names () =
76
+
let readme = read_file [ "README.md"; "ocaml-oauth/README.md" ] in
77
+
Alcotest.(check bool)
78
+
"README should not reference removed Github_oauth module" false
79
+
(contains readme ~substring:"Github_oauth");
80
+
Alcotest.(check bool)
81
+
"README should not reference callback_url" false
82
+
(contains readme ~substring:"callback_url");
83
+
Alcotest.(check bool)
84
+
"README should not reference access_token_url" false
85
+
(contains readme ~substring:"access_token_url");
86
+
Alcotest.(check bool)
87
+
"README should use current package name" true
88
+
(contains readme ~substring:"opam install oauth")
89
+
90
+
let test_opam_declares_test_runtime_dependencies () =
91
+
let opam = read_file [ "oauth.opam"; "ocaml-oauth/oauth.opam" ] in
92
+
let test_dune = read_file [ "test/dune"; "ocaml-oauth/test/dune" ] in
93
+
let fuzz_dune = read_file [ "fuzz/dune"; "ocaml-oauth/fuzz/dune" ] in
94
+
let needs_crypto_rng_unix =
95
+
contains test_dune ~substring:"crypto-rng.unix"
96
+
|| contains fuzz_dune ~substring:"crypto-rng.unix"
97
+
in
98
+
if needs_crypto_rng_unix then
99
+
Alcotest.(check bool)
100
+
"opam should declare crypto-rng.unix when tests require it" true
101
+
(contains opam ~substring:"\"crypto-rng.unix\"")
102
+
103
+
let suite =
104
+
( "regressions",
105
+
[
106
+
Alcotest.test_case "authorization_url includes response_type" `Quick
107
+
test_authorization_url_includes_response_type_code;
108
+
Alcotest.test_case "exchange_request_body uses form encoding" `Quick
109
+
test_exchange_request_body_uses_form_encoding;
110
+
Alcotest.test_case "refresh_request_body uses form encoding" `Quick
111
+
test_refresh_request_body_uses_form_encoding;
112
+
] )