gazagnaire.org
GitHub OAuth helpers
1(** GitHub OAuth URL generation and token exchange helpers. *)
2
3let src = Logs.Src.create "github-oauth" ~doc:"GitHub OAuth helpers"
4
5module Log = (val Logs.src_log src : Logs.LOG)
6
7(* JSON helpers *)
8let decode codec s = Jsont_bytesrw.decode_string codec s
9
10let encode codec v =
11 Jsont_bytesrw.encode_string codec v |> Result.value ~default:"{}"
12
13let generate_state () = Ohex.encode (Crypto_rng.generate 32)
14
15let authorization_url ~client_id ~callback_url ~state ~scope =
16 let base_query =
17 [
18 ("client_id", [ client_id ]);
19 ("redirect_uri", [ callback_url ]);
20 ("state", [ state ]);
21 ]
22 in
23 let query =
24 match scope with
25 | [] -> base_query
26 | lst -> ("scope", [ String.concat " " lst ]) :: base_query
27 in
28 let uri =
29 Uri.make ~scheme:"https" ~host:"github.com" ~path:"/login/oauth/authorize"
30 ~query ()
31 in
32 Uri.to_string uri
33
34let access_token_url = "https://github.com/login/oauth/access_token"
35
36(* JSON codecs *)
37
38let exchange_body_jsont =
39 Jsont.Object.map ~kind:"exchange_body"
40 (fun client_id client_secret code redirect_uri ->
41 (client_id, client_secret, code, redirect_uri))
42 |> Jsont.Object.mem "client_id" Jsont.string ~enc:(fun (c, _, _, _) -> c)
43 |> Jsont.Object.mem "client_secret" Jsont.string ~enc:(fun (_, s, _, _) -> s)
44 |> Jsont.Object.mem "code" Jsont.string ~enc:(fun (_, _, c, _) -> c)
45 |> Jsont.Object.mem "redirect_uri" Jsont.string ~enc:(fun (_, _, _, r) -> r)
46 |> Jsont.Object.finish
47
48let exchange_request_body ~client_id ~client_secret ~code ~redirect_uri =
49 encode exchange_body_jsont (client_id, client_secret, code, redirect_uri)
50
51type token_response = {
52 access_token : string;
53 expires_in : int option;
54 refresh_token : string option;
55 refresh_token_expires_in : int option;
56}
57
58let token_response_jsont =
59 Jsont.Object.map ~kind:"token_response"
60 (fun access_token expires_in refresh_token refresh_token_expires_in ->
61 { access_token; expires_in; refresh_token; refresh_token_expires_in })
62 |> Jsont.Object.mem "access_token" Jsont.string ~enc:(fun t -> t.access_token)
63 |> Jsont.Object.opt_mem "expires_in" Jsont.int ~enc:(fun t -> t.expires_in)
64 |> Jsont.Object.opt_mem "refresh_token" Jsont.string ~enc:(fun t ->
65 t.refresh_token)
66 |> Jsont.Object.opt_mem "refresh_token_expires_in" Jsont.int ~enc:(fun t ->
67 t.refresh_token_expires_in)
68 |> Jsont.Object.skip_unknown |> Jsont.Object.finish
69
70type parse_token_error =
71 | Invalid_json
72 | Missing_access_token
73 | Invalid_token_format
74
75let pp_parse_token_error fmt = function
76 | Invalid_json -> Fmt.pf fmt "Invalid JSON"
77 | Missing_access_token -> Fmt.pf fmt "Missing access_token field"
78 | Invalid_token_format -> Fmt.pf fmt "Invalid token format"
79
80let parse_token_response body =
81 match decode token_response_jsont body with
82 | Ok t -> Ok t
83 | Error e ->
84 Log.warn (fun m -> m "Token parse failed: %s" e);
85 Error Invalid_json
86
87let refresh_body_jsont =
88 Jsont.Object.map ~kind:"refresh_body"
89 (fun client_id client_secret grant_type refresh_token ->
90 (client_id, client_secret, grant_type, refresh_token))
91 |> Jsont.Object.mem "client_id" Jsont.string ~enc:(fun (c, _, _, _) -> c)
92 |> Jsont.Object.mem "client_secret" Jsont.string ~enc:(fun (_, s, _, _) -> s)
93 |> Jsont.Object.mem "grant_type" Jsont.string ~enc:(fun (_, _, g, _) -> g)
94 |> Jsont.Object.mem "refresh_token" Jsont.string ~enc:(fun (_, _, _, r) -> r)
95 |> Jsont.Object.finish
96
97let refresh_request_body ~client_id ~client_secret ~refresh_token =
98 encode refresh_body_jsont
99 (client_id, client_secret, "refresh_token", refresh_token)