gazagnaire.org
GitHub OAuth helpers
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: MIT
4 ---------------------------------------------------------------------------*)
5
6open Crowbar
7
8let () = Crypto_rng_unix.use_default ()
9
10(* Test that authorization_url always produces valid URLs *)
11let test_authorization_url_valid client_id callback_url state scope =
12 let url =
13 Github_oauth.authorization_url ~client_id ~callback_url ~state ~scope
14 in
15 (* Should always start with https://github.com *)
16 check (String.length url > 0);
17 check (String.sub url 0 8 = "https://")
18
19(* Test that exchange_request_body produces valid JSON *)
20let test_exchange_body_valid client_id client_secret code redirect_uri =
21 let body =
22 Github_oauth.exchange_request_body ~client_id ~client_secret ~code
23 ~redirect_uri
24 in
25 (* Should be valid JSON - contains opening brace *)
26 check (String.length body > 2);
27 check (body.[0] = '{')
28
29(* Test that refresh_request_body produces valid JSON *)
30let test_refresh_body_valid client_id client_secret refresh_token =
31 let body =
32 Github_oauth.refresh_request_body ~client_id ~client_secret ~refresh_token
33 in
34 check (String.length body > 2);
35 check (body.[0] = '{')
36
37(* Test that parse_token_response handles arbitrary input without crashing *)
38let test_parse_no_crash input =
39 let _ = Github_oauth.parse_token_response input in
40 check true
41
42(* Test roundtrip: encode a valid token response, then parse it *)
43let test_token_roundtrip access_token expires_in refresh_token =
44 let json =
45 let parts =
46 [ Fmt.str {|"access_token":"%s"|} access_token ]
47 @ (match expires_in with
48 | None -> []
49 | Some n -> [ Fmt.str {|"expires_in":%d|} (abs n mod 100000) ])
50 @
51 match refresh_token with
52 | None -> []
53 | Some rt -> [ Fmt.str {|"refresh_token":"%s"|} rt ]
54 in
55 "{" ^ String.concat "," parts ^ "}"
56 in
57 match Github_oauth.parse_token_response json with
58 | Ok t -> check (t.access_token = access_token)
59 | Error _ -> check true (* some inputs may be invalid JSON *)
60
61let suite =
62 ( "github_oauth",
63 [
64 test_case "authorization_url valid"
65 [ bytes; bytes; bytes; list bytes ]
66 test_authorization_url_valid;
67 test_case "exchange_body valid"
68 [ bytes; bytes; bytes; bytes ]
69 test_exchange_body_valid;
70 test_case "refresh_body valid" [ bytes; bytes; bytes ]
71 test_refresh_body_valid;
72 test_case "parse_no_crash" [ bytes ] test_parse_no_crash;
73 test_case "token roundtrip"
74 [ bytes; option int; option bytes ]
75 test_token_roundtrip;
76 ] )