objective categorical abstract machine language personal data server
client metadata
+64
+64
pegasus/lib/oauth/client.ml
+64
pegasus/lib/oauth/client.ml
···
1
+
type metadata =
2
+
{ client_id: string
3
+
; client_name: string option
4
+
; client_uri: string
5
+
; redirect_uris: string list
6
+
; grant_types: string list
7
+
; response_types: string list
8
+
; scope: string
9
+
; token_endpoint_auth_method: string
10
+
; application_type: string
11
+
; dpop_bound_access_tokens: bool
12
+
; jwks_uri: string option
13
+
; jwks: Yojson.Safe.t option }
14
+
15
+
let fetch_client_metadata client_id =
16
+
let%lwt {status; _}, res =
17
+
Cohttp_lwt_unix.Client.get (Uri.of_string client_id)
18
+
in
19
+
if status <> `OK then
20
+
let%lwt () = Cohttp_lwt.Body.drain_body res in
21
+
Errors.invalid_request "client metadata not found"
22
+
else
23
+
let%lwt body = Cohttp_lwt.Body.to_string res in
24
+
let json = Yojson.Safe.from_string body in
25
+
let open Yojson.Safe.Util in
26
+
let metadata =
27
+
{ client_id= json |> member "client_id" |> to_string
28
+
; client_name= json |> member "client_name" |> to_string_option
29
+
; client_uri= json |> member "client_uri" |> to_string
30
+
; redirect_uris=
31
+
json |> member "redirect_uris" |> to_list |> List.map to_string
32
+
; grant_types=
33
+
json |> member "grant_types" |> to_list |> List.map to_string
34
+
; response_types=
35
+
json |> member "response_types" |> to_list |> List.map to_string
36
+
; scope= json |> member "scope" |> to_string
37
+
; token_endpoint_auth_method=
38
+
json |> member "token_endpoint_auth_method" |> to_string
39
+
; application_type= json |> member "application_type" |> to_string
40
+
; dpop_bound_access_tokens=
41
+
json |> member "dpop_bound_access_tokens" |> to_bool
42
+
; jwks_uri= json |> member "jwks_uri" |> to_string_option
43
+
; jwks= json |> member "jwks" |> to_option Fun.id }
44
+
in
45
+
if metadata.client_id <> client_id then
46
+
Errors.invalid_request "client_id mismatch"
47
+
else
48
+
let scopes = String.split_on_char ' ' metadata.scope in
49
+
if not (List.mem "atproto" scopes) then
50
+
Errors.invalid_request "scope must include 'atproto'"
51
+
else
52
+
List.iter
53
+
(fun uri ->
54
+
let u = Uri.of_string uri in
55
+
match Uri.scheme u with
56
+
| Some "https" ->
57
+
()
58
+
| Some "http"
59
+
when Uri.host u = Some "127.0.0.1" || Uri.host u = Some "[::1]" ->
60
+
()
61
+
| _ ->
62
+
Errors.invalid_request ("invalid redirect_uri: " ^ uri) )
63
+
metadata.redirect_uris ;
64
+
Lwt.return metadata