objective categorical abstract machine language personal data server
Permission sets support
+1186
-120
+389
-46
frontend/src/templates/OauthAuthorizePage.mlx
+389
-46
frontend/src/templates/OauthAuthorizePage.mlx
···
10
10
{did: string; handle: string; avatar_data_uri: string option [@default None]}
11
11
[@@deriving json]
12
12
13
+
type permission_set_display =
14
+
{ nsid: string
15
+
; title: string option [@default None]
16
+
; detail: string option [@default None]
17
+
; expanded_scopes: string list }
18
+
[@@deriving json]
19
+
13
20
type props =
14
21
{ client_url: string * string (* (host, path) *)
15
22
; client_name: string option [@default None]
···
17
24
; current_user: actor
18
25
; logged_in_users: actor list
19
26
; scopes: string list
27
+
; permission_sets: permission_set_display list [@default []]
20
28
; code: string
21
29
; request_uri: string
22
30
; csrf_token: string }
···
38
46
| Bluesky (* transition:generic or app.bsky.* *)
39
47
| Chat (* transition:chat.bsky or chat.bsky.* *)
40
48
| Atproto
49
+
| PermissionSet of
50
+
{ nsid: string
51
+
; title: string option
52
+
; detail: string option
53
+
; expanded_scopes: string list (* raw scope strings for display *) }
41
54
| Unknown of string
42
55
43
56
let parse_scope scope =
···
45
58
else if scope = "transition:generic" then Bluesky
46
59
else if scope = "transition:chat.bsky" then Chat
47
60
else if scope = "transition:email" then Email `Read
48
-
else if String.starts_with ~prefix:"account:email" scope then
49
-
if String.exists (fun c -> c = '=') scope then Email `Manage
50
-
else Email `Read
51
-
else if String.starts_with ~prefix:"identity:" scope then
61
+
else if
62
+
String.starts_with ~prefix:"account:" scope
63
+
|| String.starts_with ~prefix:"account?" scope
64
+
then
65
+
let has_positional = String.starts_with ~prefix:"account:" scope in
66
+
let rest =
67
+
String.sub scope 8 (String.length scope - 8)
68
+
in
69
+
let parts = String.split_on_char '?' rest in
70
+
let positional_attr =
71
+
if has_positional then
72
+
match parts with a :: _ when a <> "" -> Some a | _ -> None
73
+
else None
74
+
in
75
+
let query_str =
76
+
if has_positional then
77
+
if List.length parts > 1 then Some (List.nth parts 1) else None
78
+
else if rest <> "" then Some rest
79
+
else None
80
+
in
81
+
let parse_query_params qs =
82
+
String.split_on_char '&' qs
83
+
|> List.filter_map (fun pair ->
84
+
match String.split_on_char '=' pair with
85
+
| [k; v] ->
86
+
Some (k, v)
87
+
| _ ->
88
+
None )
89
+
in
90
+
let params =
91
+
Option.map parse_query_params query_str |> Option.value ~default:[]
92
+
in
93
+
let attr =
94
+
match positional_attr with
95
+
| Some a ->
96
+
a
97
+
| None ->
98
+
List.find_map
99
+
(fun (k, v) -> if k = "attr" then Some v else None)
100
+
params
101
+
|> Option.value ~default:""
102
+
in
103
+
let action =
104
+
List.find_map
105
+
(fun (k, v) -> if k = "action" then Some v else None)
106
+
params
107
+
|> Option.value ~default:"read"
108
+
in
109
+
if attr = "email" then
110
+
if action = "manage" then Email `Manage else Email `Read
111
+
else Unknown scope (* repo and other attrs not displayed specially *)
112
+
else if
113
+
String.starts_with ~prefix:"identity:" scope
114
+
|| String.starts_with ~prefix:"identity?" scope
115
+
then
116
+
(* attrs are "handle" or "*" *)
117
+
let has_positional = String.starts_with ~prefix:"identity:" scope in
52
118
let rest = String.sub scope 9 (String.length scope - 9) in
53
-
if rest = "*" || String.starts_with ~prefix:"*" rest then Identity `Full
54
-
else Identity `Handle
55
-
else if String.starts_with ~prefix:"repo:" scope then
119
+
let parts = String.split_on_char '?' rest in
120
+
let positional_attr =
121
+
if has_positional then
122
+
match parts with a :: _ when a <> "" -> Some a | _ -> None
123
+
else None
124
+
in
125
+
let attr =
126
+
match positional_attr with
127
+
| Some a ->
128
+
a
129
+
| None ->
130
+
let params =
131
+
if has_positional then
132
+
if List.length parts > 1 then List.nth parts 1 else ""
133
+
else rest
134
+
in
135
+
String.split_on_char '&' params
136
+
|> List.find_map (fun pair ->
137
+
match String.split_on_char '=' pair with
138
+
| [k; v] when k = "attr" ->
139
+
Some v
140
+
| _ ->
141
+
None )
142
+
|> Option.value ~default:"handle"
143
+
in
144
+
if attr = "*" then Identity `Full else Identity `Handle
145
+
else if
146
+
String.starts_with ~prefix:"repo:" scope
147
+
|| String.starts_with ~prefix:"repo?" scope
148
+
then
149
+
let has_positional = String.starts_with ~prefix:"repo:" scope in
56
150
let rest = String.sub scope 5 (String.length scope - 5) in
57
151
let parts = String.split_on_char '?' rest in
152
+
let positional_coll =
153
+
if has_positional then
154
+
match parts with coll :: _ when coll <> "" -> Some coll | _ -> None
155
+
else None
156
+
in
157
+
let query_str =
158
+
if has_positional then
159
+
if List.length parts > 1 then Some (List.nth parts 1) else None
160
+
else if
161
+
(* for repo?... format, rest starts with the query string *)
162
+
rest <> ""
163
+
then Some rest
164
+
else None
165
+
in
166
+
let parse_query_params qs =
167
+
String.split_on_char '&' qs
168
+
|> List.filter_map (fun pair ->
169
+
match String.split_on_char '=' pair with
170
+
| [k; v] ->
171
+
Some (k, v)
172
+
| _ ->
173
+
None )
174
+
in
175
+
let params =
176
+
Option.map parse_query_params query_str |> Option.value ~default:[]
177
+
in
58
178
let collection =
59
-
match parts with coll :: _ when coll <> "" -> [coll] | _ -> ["*"]
179
+
match positional_coll with
180
+
| Some c ->
181
+
[c]
182
+
| None -> (
183
+
List.filter_map
184
+
(fun (k, v) -> if k = "collection" then Some v else None)
185
+
params
186
+
|> function [] -> ["*"] | cols -> cols )
60
187
in
61
188
let actions =
62
-
if List.length parts > 1 then
63
-
let params = List.nth parts 1 in
64
-
if String.contains params '=' then
65
-
List.filter_map
66
-
(fun a ->
67
-
if
68
-
String.ends_with ~suffix:a params
69
-
|| String.contains params ','
70
-
then
71
-
match a with
72
-
| "create" ->
73
-
Some Create
74
-
| "update" ->
75
-
Some Update
76
-
| "delete" ->
77
-
Some Delete
78
-
| _ ->
79
-
None
80
-
else None )
81
-
["create"; "update"; "delete"]
82
-
|> function [] -> [Create; Update; Delete] | l -> l
83
-
else [Create; Update; Delete]
84
-
else [Create; Update; Delete]
189
+
let action_strs =
190
+
List.filter_map
191
+
(fun (k, v) -> if k = "action" then Some v else None)
192
+
params
193
+
|> List.concat_map (String.split_on_char ',')
194
+
in
195
+
if action_strs = [] then [Create; Update; Delete]
196
+
else
197
+
List.filter_map
198
+
(fun a ->
199
+
match a with
200
+
| "create" ->
201
+
Some Create
202
+
| "update" ->
203
+
Some Update
204
+
| "delete" ->
205
+
Some Delete
206
+
| _ ->
207
+
None )
208
+
action_strs
209
+
|> function [] -> [Create; Update; Delete] | l -> l
85
210
in
86
211
if
87
212
List.exists
···
97
222
then Chat
98
223
else Bluesky
99
224
else Repo {collections= collection; actions}
100
-
else if String.starts_with ~prefix:"rpc:" scope then
225
+
else if
226
+
String.starts_with ~prefix:"rpc:" scope
227
+
|| String.starts_with ~prefix:"rpc?" scope
228
+
then
229
+
let has_positional = String.starts_with ~prefix:"rpc:" scope in
101
230
let rest = String.sub scope 4 (String.length scope - 4) in
102
231
let parts = String.split_on_char '?' rest in
103
-
let lxm = match parts with l :: _ -> l | [] -> "*" in
232
+
let positional_lxm =
233
+
if has_positional then
234
+
match parts with l :: _ when l <> "" -> Some l | _ -> None
235
+
else None
236
+
in
237
+
let query_str =
238
+
if has_positional then
239
+
if List.length parts > 1 then Some (List.nth parts 1) else None
240
+
else if rest <> "" then Some rest
241
+
else None
242
+
in
243
+
let parse_query_params qs =
244
+
String.split_on_char '&' qs
245
+
|> List.filter_map (fun pair ->
246
+
match String.split_on_char '=' pair with
247
+
| [k; v] ->
248
+
Some (k, v)
249
+
| _ ->
250
+
None )
251
+
in
252
+
let params =
253
+
Option.map parse_query_params query_str |> Option.value ~default:[]
254
+
in
255
+
let lxm =
256
+
match positional_lxm with
257
+
| Some l ->
258
+
l
259
+
| None ->
260
+
List.find_map
261
+
(fun (k, v) -> if k = "lxm" then Some v else None)
262
+
params
263
+
|> Option.value ~default:"*"
264
+
in
104
265
let aud =
105
-
if List.length parts > 1 then
106
-
let params = List.nth parts 1 in
107
-
if String.starts_with ~prefix:"aud=" params then
108
-
String.sub params 4 (String.length params - 4)
109
-
else "*"
110
-
else "*"
266
+
List.find_map (fun (k, v) -> if k = "aud" then Some v else None) params
267
+
|> Option.value ~default:"*"
111
268
in
112
269
if String.starts_with ~prefix:"app.bsky." lxm then Bluesky
113
270
else if String.starts_with ~prefix:"chat.bsky." lxm then Chat
114
271
else Rpc {lxm; aud}
115
-
else if String.starts_with ~prefix:"blob:" scope then
272
+
else if
273
+
String.starts_with ~prefix:"blob:" scope
274
+
|| String.starts_with ~prefix:"blob?" scope
275
+
then
276
+
let has_positional = String.starts_with ~prefix:"blob:" scope in
116
277
let rest = String.sub scope 5 (String.length scope - 5) in
117
-
Blob [rest]
278
+
let mimetypes =
279
+
if has_positional then [rest]
280
+
else
281
+
String.split_on_char '&' rest
282
+
|> List.filter_map (fun pair ->
283
+
match String.split_on_char '=' pair with
284
+
| [k; v] when k = "accept" ->
285
+
Some v
286
+
| _ ->
287
+
None )
288
+
in
289
+
Blob (if mimetypes = [] then ["*/*"] else mimetypes)
118
290
else Unknown scope
119
291
292
+
(* parse repo scope string without converting app.bsky/chat.bsky to Bluesky/Chat *)
293
+
let parse_repo_scope_raw scope =
294
+
if
295
+
String.starts_with ~prefix:"repo:" scope
296
+
|| String.starts_with ~prefix:"repo?" scope
297
+
then
298
+
let has_positional = String.starts_with ~prefix:"repo:" scope in
299
+
let rest = String.sub scope 5 (String.length scope - 5) in
300
+
let parts = String.split_on_char '?' rest in
301
+
let positional_coll =
302
+
if has_positional then
303
+
match parts with coll :: _ when coll <> "" -> Some coll | _ -> None
304
+
else None
305
+
in
306
+
let query_str =
307
+
if has_positional then
308
+
if List.length parts > 1 then Some (List.nth parts 1) else None
309
+
else if rest <> "" then Some rest
310
+
else None
311
+
in
312
+
let parse_query_params qs =
313
+
String.split_on_char '&' qs
314
+
|> List.filter_map (fun pair ->
315
+
match String.split_on_char '=' pair with
316
+
| [k; v] ->
317
+
Some (k, v)
318
+
| _ ->
319
+
None )
320
+
in
321
+
let params =
322
+
Option.map parse_query_params query_str |> Option.value ~default:[]
323
+
in
324
+
let collection =
325
+
match positional_coll with
326
+
| Some c ->
327
+
[c]
328
+
| None -> (
329
+
List.filter_map
330
+
(fun (k, v) -> if k = "collection" then Some v else None)
331
+
params
332
+
|> function [] -> ["*"] | cols -> cols )
333
+
in
334
+
let actions =
335
+
let action_strs =
336
+
List.filter_map
337
+
(fun (k, v) -> if k = "action" then Some v else None)
338
+
params
339
+
|> List.concat_map (String.split_on_char ',')
340
+
in
341
+
if action_strs = [] then [Create; Update; Delete]
342
+
else
343
+
List.filter_map
344
+
(fun a ->
345
+
match a with
346
+
| "create" ->
347
+
Some Create
348
+
| "update" ->
349
+
Some Update
350
+
| "delete" ->
351
+
Some Delete
352
+
| _ ->
353
+
None )
354
+
action_strs
355
+
|> function [] -> [Create; Update; Delete] | l -> l
356
+
in
357
+
Some {collections= collection; actions}
358
+
else None
359
+
120
360
type collection_actions = {create: bool; update: bool; delete: bool}
121
361
122
362
module StringMap = Map.Make (String)
···
184
424
has_chat := true
185
425
| Atproto ->
186
426
()
427
+
| PermissionSet _ ->
428
+
()
187
429
| Unknown s ->
188
430
unknowns := s :: !unknowns )
189
431
scopes ;
···
196
438
, !has_chat
197
439
, !unknowns )
198
440
199
-
let[@react.component] make ~scopes () =
441
+
let[@react.component] make ~scopes ?(permission_sets = []) () =
200
442
let email, identity, repos, rpcs, blobs, has_bluesky, has_chat, unknowns =
201
443
merge_parsed_scopes scopes
202
444
in
445
+
let ps_displays =
446
+
List.map
447
+
(fun (ps : permission_set_display) ->
448
+
PermissionSet
449
+
{ nsid= ps.nsid
450
+
; title= ps.title
451
+
; detail= ps.detail
452
+
; expanded_scopes= ps.expanded_scopes } )
453
+
permission_sets
454
+
in
203
455
<div className="w-full mt-3 space-y-1">
204
456
( match email with
205
457
| Some level ->
···
279
531
</div>
280
532
</div>
281
533
else null )
282
-
( if List.length repos > 0 && not has_bluesky then
534
+
( if List.length repos > 0 then
283
535
let coll_actions_map = build_collection_actions_map repos in
284
536
let coll_actions_list =
285
537
StringMap.bindings coll_actions_map
···
482
734
</div>
483
735
</div>
484
736
else null )
485
-
( if List.length blobs > 0 && not has_bluesky then
737
+
( if List.length blobs > 0 then
486
738
<div className="flex items-start gap-3 p-3 rounded-lg">
487
739
<div
488
740
className="flex-shrink-0 w-8 h-8 flex items-center \
···
523
775
</div>
524
776
</div>
525
777
else null )
778
+
(* permission sets *)
779
+
( List.map
780
+
(fun ps ->
781
+
match ps with
782
+
| PermissionSet {nsid; title; detail; expanded_scopes} ->
783
+
let repos =
784
+
List.filter_map parse_repo_scope_raw expanded_scopes
785
+
in
786
+
let coll_actions_map = build_collection_actions_map repos in
787
+
let coll_actions_list =
788
+
StringMap.bindings coll_actions_map
789
+
|> List.sort (fun (a, _) (b, _) -> String.compare a b)
790
+
in
791
+
<div key=nsid className="flex items-start gap-3 p-3 rounded-lg">
792
+
<div
793
+
className="flex-shrink-0 w-8 h-8 flex items-center \
794
+
justify-center rounded-full bg-mist-20/50 \
795
+
text-mist-80">
796
+
<BoxesIcon className="w-4 h-4" />
797
+
</div>
798
+
<div className="flex-1 min-w-0">
799
+
<div className="font-serif text-mana-100">
800
+
(string (Option.value title ~default:nsid))
801
+
</div>
802
+
( match detail with
803
+
| Some d ->
804
+
<div className="text-sm text-mist-100">(string d)</div>
805
+
| None ->
806
+
null )
807
+
( if List.length coll_actions_list > 0 then
808
+
<table className="w-full mt-2 text-xs">
809
+
<thead>
810
+
<tr className="text-mist-80">
811
+
<th className="text-left font-normal pb-1">
812
+
(string "Collection")
813
+
</th>
814
+
<th className="text-center font-normal pb-1 w-16">
815
+
(string "Create")
816
+
</th>
817
+
<th className="text-center font-normal pb-1 w-16">
818
+
(string "Update")
819
+
</th>
820
+
<th className="text-center font-normal pb-1 w-16">
821
+
(string "Delete")
822
+
</th>
823
+
</tr>
824
+
</thead>
825
+
<tbody>
826
+
( coll_actions_list
827
+
|> List.map (fun (coll, actions) ->
828
+
<tr key=coll className="text-mist-100">
829
+
<td className="py-0.5">
830
+
<span className="font-medium">
831
+
(string
832
+
( if coll = "*" then "Any collection"
833
+
else coll ) )
834
+
</span>
835
+
</td>
836
+
<td className="text-center">
837
+
( if actions.create then
838
+
<span className="text-mana-100">
839
+
(string {js|✓|js})
840
+
</span>
841
+
else null )
842
+
</td>
843
+
<td className="text-center">
844
+
( if actions.update then
845
+
<span className="text-mana-100">
846
+
(string {js|✓|js})
847
+
</span>
848
+
else null )
849
+
</td>
850
+
<td className="text-center">
851
+
( if actions.delete then
852
+
<span className="text-mana-100">
853
+
(string {js|✓|js})
854
+
</span>
855
+
else null )
856
+
</td>
857
+
</tr> )
858
+
|> Array.of_list |> array )
859
+
</tbody>
860
+
</table>
861
+
else null )
862
+
</div>
863
+
</div>
864
+
| _ ->
865
+
null )
866
+
ps_displays
867
+
|> Array.of_list |> React.array )
526
868
</div>
527
869
end
528
870
···
534
876
; current_user
535
877
; logged_in_users
536
878
; scopes
879
+
; permission_sets
537
880
; code
538
881
; request_uri
539
882
; csrf_token } :
···
565
908
useState (fun () ->
566
909
Option.value logo_uri ~default:("https://" ^ host ^ "/favicon.ico") )
567
910
in
568
-
<form className="w-full h-auto max-w-lg px-4 sm:px-0 my-auto">
911
+
<form className="w-full h-auto max-w-lg px-4 sm:px-0 py-16 my-auto">
569
912
<h1 className="text-2xl font-serif text-mana-200 mb-2">
570
913
(string ("authorizing " ^ host))
571
914
</h1>
···
583
926
/>
584
927
(string " and granting it the following permissions:")
585
928
</span>
586
-
<ScopesTable scopes />
929
+
<ScopesTable scopes permission_sets />
587
930
<div className="w-full flex flex-row items-center justify-between mt-6">
588
931
<input type_="hidden" name="dream.csrf" value=csrf_token />
589
932
<input type_="hidden" name="code" value=code />
+32
hermes-cli/lib/codegen.ml
+32
hermes-cli/lib/codegen.ml
···
62
62
"Yojson.Safe.t"
63
63
| Query _ | Procedure _ | Subscription _ | Record _ ->
64
64
"unit (* primary type *)"
65
+
| PermissionSet _ ->
66
+
"unit (* permission-set type *)"
65
67
66
68
(* generate reference to another type *)
67
69
and gen_ref_type nsid out ref_str : string =
···
698
700
emitln out (Printf.sprintf "let %s = \"%s\"" (Naming.type_name name) full_uri) ;
699
701
emit_newline out
700
702
703
+
(* generate permission set module *)
704
+
let gen_permission_set_module nsid out name (_spec : permission_set_spec) =
705
+
let type_name = Naming.type_name name in
706
+
(* generate permission type *)
707
+
emitln out (Printf.sprintf "(** %s *)" nsid) ;
708
+
emitln out "type permission =" ;
709
+
emitln out " { resource: string" ;
710
+
emitln out " ; lxm: string list option [@default None]" ;
711
+
emitln out " ; aud: string option [@default None]" ;
712
+
emitln out
713
+
" ; inherit_aud: bool option [@key \"inheritAud\"] [@default None]" ;
714
+
emitln out " ; collection: string list option [@default None]" ;
715
+
emitln out " ; action: string list option [@default None]" ;
716
+
emitln out " ; accept: string list option [@default None] }" ;
717
+
emitln out "[@@deriving yojson {strict= false}]" ;
718
+
emit_newline out ;
719
+
(* generate main type *)
720
+
emitln out (Printf.sprintf "type %s =" type_name) ;
721
+
emitln out " { title: string option [@default None]" ;
722
+
emitln out " ; detail: string option [@default None]" ;
723
+
emitln out " ; permissions: permission list }" ;
724
+
emitln out "[@@deriving yojson {strict= false}]" ;
725
+
emit_newline out
726
+
701
727
(* generate string type alias (for strings with knownValues) *)
702
728
let gen_string_type out name (spec : string_spec) =
703
729
let type_name = Naming.type_name name in
···
743
769
gen_procedure nsid out def.name spec
744
770
| Record spec ->
745
771
gen_object_type ~first ~last nsid out def.name spec.record
772
+
| PermissionSet spec ->
773
+
gen_permission_set_module nsid out def.name spec
746
774
| String spec when spec.known_values <> None ->
747
775
gen_string_type out def.name spec
748
776
| String _
···
1099
1127
"Yojson.Safe.t"
1100
1128
| Query _ | Procedure _ | Subscription _ | Record _ ->
1101
1129
"unit (* primary type *)"
1130
+
| PermissionSet _ ->
1131
+
"unit (* permission-set type *)"
1102
1132
and gen_merged_ref_type current_nsid ref_str =
1103
1133
if String.length ref_str > 0 && ref_str.[0] = '#' then begin
1104
1134
(* local ref within same nsid *)
···
2274
2304
"Yojson.Safe.t"
2275
2305
| Query _ | Procedure _ | Subscription _ | Record _ ->
2276
2306
"unit (* primary type *)"
2307
+
| PermissionSet _ ->
2308
+
"unit (* permission-set type *)"
2277
2309
and gen_shared_ref_type current_nsid ref_str =
2278
2310
if String.length ref_str > 0 && ref_str.[0] = '#' then begin
2279
2311
(* local ref within same nsid *)
+13
hermes-cli/lib/lexicon_types.ml
+13
hermes-cli/lib/lexicon_types.ml
···
88
88
; record: object_spec
89
89
; description: string option }
90
90
91
+
and lex_permission =
92
+
{ resource: string
93
+
; extra: (string * Yojson.Safe.t) list }
94
+
95
+
and permission_set_spec =
96
+
{ title: string option
97
+
; title_lang: (string * string) list option
98
+
; detail: string option
99
+
; detail_lang: (string * string) list option
100
+
; permissions: lex_permission list
101
+
; description: string option }
102
+
91
103
and type_def =
92
104
| String of string_spec
93
105
| Integer of integer_spec
···
105
117
| Procedure of procedure_spec
106
118
| Subscription of subscription_spec
107
119
| Record of record_spec
120
+
| PermissionSet of permission_set_spec
108
121
109
122
type def_entry = {name: string; type_def: type_def}
110
123
+54
hermes-cli/lib/parser.ml
+54
hermes-cli/lib/parser.ml
···
151
151
Subscription (parse_subscription_spec json)
152
152
| "record" ->
153
153
Record (parse_record_spec json)
154
+
| "permission-set" ->
155
+
PermissionSet (parse_permission_set_spec json)
154
156
| t ->
155
157
failwith ("unknown type: " ^ t)
156
158
···
317
319
in
318
320
{ key
319
321
; record= parse_object_spec record_json
322
+
; description= get_string_opt "description" json }
323
+
324
+
and parse_permission json : lex_permission =
325
+
let resource = get_string "resource" json in
326
+
let extra =
327
+
match json with
328
+
| `Assoc pairs ->
329
+
List.filter (fun (k, _) -> k <> "resource") pairs
330
+
| _ ->
331
+
[]
332
+
in
333
+
{resource; extra}
334
+
335
+
and parse_lang_map key json : (string * string) list option =
336
+
match json with
337
+
| `Assoc pairs ->
338
+
let prefix = key ^ ":" in
339
+
let lang_pairs =
340
+
List.filter_map
341
+
(fun (k, v) ->
342
+
if String.starts_with ~prefix k then
343
+
let lang =
344
+
String.sub k (String.length prefix)
345
+
(String.length k - String.length prefix)
346
+
in
347
+
match v with `String s -> Some (lang, s) | _ -> None
348
+
else None )
349
+
pairs
350
+
in
351
+
if lang_pairs = [] then None else Some lang_pairs
352
+
| _ ->
353
+
None
354
+
355
+
and parse_permission_set_spec json : permission_set_spec =
356
+
let permissions =
357
+
match get_list_opt "permissions" json with
358
+
| Some l ->
359
+
List.map
360
+
(function
361
+
| `Assoc _ as j ->
362
+
parse_permission j
363
+
| _ ->
364
+
failwith "invalid permission" )
365
+
l
366
+
| None ->
367
+
[]
368
+
in
369
+
{ title= get_string_opt "title" json
370
+
; title_lang= parse_lang_map "title" json
371
+
; detail= get_string_opt "detail" json
372
+
; detail_lang= parse_lang_map "detail" json
373
+
; permissions
320
374
; description= get_string_opt "description" json }
321
375
322
376
(* parse complete lexicon document *)
+41
-1
hermes-cli/test/test_codegen.ml
+41
-1
hermes-cli/test/test_codegen.ml
···
427
427
(contains code "type status = string") ;
428
428
check bool "contains status_of_yojson" true (contains code "status_of_yojson")
429
429
430
+
(* test generating permission-set module *)
431
+
let test_gen_permission_set () =
432
+
let perm1 : Lexicon_types.lex_permission =
433
+
{ resource= "rpc"
434
+
; extra=
435
+
[("lxm", `List [`String "com.example.foo"]); ("inheritAud", `Bool true)]
436
+
}
437
+
in
438
+
let perm2 : Lexicon_types.lex_permission =
439
+
{ resource= "repo"
440
+
; extra= [("collection", `List [`String "com.example.data"])] }
441
+
in
442
+
let ps_spec : Lexicon_types.permission_set_spec =
443
+
{ title= Some "Test Permissions"
444
+
; title_lang= Some [("de", "Test Berechtigungen")]
445
+
; detail= Some "Access to test features"
446
+
; detail_lang= None
447
+
; permissions= [perm1; perm2]
448
+
; description= None }
449
+
in
450
+
let doc =
451
+
make_lexicon "com.example.perms"
452
+
[make_def "main" (Lexicon_types.PermissionSet ps_spec)]
453
+
in
454
+
let code = Codegen.gen_lexicon_module doc in
455
+
check bool "contains type permission" true (contains code "type permission =") ;
456
+
check bool "contains resource field" true (contains code "resource: string") ;
457
+
check bool "contains lxm field" true (contains code "lxm: string list option") ;
458
+
check bool "contains inherit_aud field" true
459
+
(contains code "inherit_aud: bool option") ;
460
+
check bool "contains type main" true (contains code "type main =") ;
461
+
check bool "contains title field" true (contains code "title: string option") ;
462
+
check bool "contains permissions field" true
463
+
(contains code "permissions: permission list") ;
464
+
check bool "contains deriving" true (contains code "[@@deriving yojson")
465
+
430
466
(* test generating query with bytes output (like getBlob) *)
431
467
let test_gen_query_bytes_output () =
432
468
let params_spec =
···
514
550
let string_tests =
515
551
[("string with known values", `Quick, test_gen_string_known_values)]
516
552
553
+
let permission_set_tests =
554
+
[("generate permission-set", `Quick, test_gen_permission_set)]
555
+
517
556
let () =
518
557
run "Codegen"
519
558
[ ("objects", object_tests)
···
521
560
; ("xrpc", xrpc_tests)
522
561
; ("ordering", ordering_tests)
523
562
; ("tokens", token_tests)
524
-
; ("strings", string_tests) ]
563
+
; ("strings", string_tests)
564
+
; ("permission-set", permission_set_tests) ]
+53
-1
hermes-cli/test/test_parser.ml
+53
-1
hermes-cli/test/test_parser.ml
···
280
280
| Error e ->
281
281
fail ("parse failed: " ^ e)
282
282
283
+
(* parsing permission-set type *)
284
+
let test_parse_permission_set () =
285
+
let json =
286
+
{|{
287
+
"lexicon": 1,
288
+
"id": "com.example.auth",
289
+
"defs": {
290
+
"main": {
291
+
"type": "permission-set",
292
+
"title": "Example Auth",
293
+
"title:de": "Beispiel Auth",
294
+
"detail": "Access to authentication features",
295
+
"permissions": [
296
+
{
297
+
"resource": "rpc",
298
+
"lxm": ["com.example.auth.login", "com.example.auth.logout"],
299
+
"inheritAud": true
300
+
},
301
+
{
302
+
"resource": "repo",
303
+
"collection": ["com.example.auth.session"],
304
+
"action": ["create", "delete"]
305
+
}
306
+
]
307
+
}
308
+
}
309
+
}|}
310
+
in
311
+
match Parser.parse_string json with
312
+
| Ok doc -> (
313
+
check test_string "id matches" "com.example.auth" doc.id ;
314
+
check int "one definition" 1 (List.length doc.defs) ;
315
+
let def = List.hd doc.defs in
316
+
match def.type_def with
317
+
| Lexicon_types.PermissionSet spec ->
318
+
check (option test_string) "title" (Some "Example Auth") spec.title ;
319
+
check (option test_string) "detail"
320
+
(Some "Access to authentication features") spec.detail ;
321
+
check int "two permissions" 2 (List.length spec.permissions) ;
322
+
let perm1 = List.hd spec.permissions in
323
+
check test_string "first resource" "rpc" perm1.resource ;
324
+
(* check extra fields are captured *)
325
+
check bool "has lxm in extra" true (List.mem_assoc "lxm" perm1.extra)
326
+
| _ ->
327
+
fail "expected permission-set type" )
328
+
| Error e ->
329
+
fail ("parse failed: " ^ e)
330
+
283
331
(* parsing invalid JSON *)
284
332
let test_parse_invalid_json () =
285
333
let json = {|{ invalid json }|} in
···
318
366
[ ("invalid json", `Quick, test_parse_invalid_json)
319
367
; ("missing field", `Quick, test_parse_missing_field) ]
320
368
369
+
let permission_set_tests =
370
+
[("parse permission-set", `Quick, test_parse_permission_set)]
371
+
321
372
let () =
322
373
run "Parser"
323
374
[ ("objects", object_tests)
324
375
; ("complex_types", complex_type_tests)
325
-
; ("errors", error_tests) ]
376
+
; ("errors", error_tests)
377
+
; ("permission-set", permission_set_tests) ]
+9
-3
pegasus/lib/api/oauth_/token.ml
+9
-3
pegasus/lib/api/oauth_/token.ml
···
86
86
in
87
87
let exp_sec = now_sec + expires_in in
88
88
let expires_at = exp_sec * 1000 in
89
+
(* expand scopes before creating token *)
90
+
let%lwt expanded_scopes =
91
+
let parsed = Scopes.parse_scopes orig_req.scope in
92
+
let%lwt expanded = Scopes.expand_scopes parsed in
93
+
Lwt.return (Scopes.scopes_to_string expanded)
94
+
in
89
95
let claims =
90
96
`Assoc
91
97
[ ("jti", `String token_id)
92
98
; ("sub", `String did)
93
99
; ("iat", `Int now_sec)
94
100
; ("exp", `Int exp_sec)
95
-
; ("scope", `String orig_req.scope)
101
+
; ("scope", `String expanded_scopes)
96
102
; ("aud", `String Env.host_endpoint)
97
103
; ("cnf", `Assoc [("jkt", `String proof.jkt)])
98
104
]
···
117
123
; client_id= req.client_id
118
124
; did
119
125
; dpop_jkt= proof.jkt
120
-
; scope= orig_req.scope
126
+
; scope= expanded_scopes
121
127
; created_at= now_ms
122
128
; last_refreshed_at= now_ms
123
129
; expires_at
···
135
141
; ("token_type", `String "DPoP")
136
142
; ("refresh_token", `String refresh_token)
137
143
; ("expires_in", `Int expires_in)
138
-
; ("scope", `String orig_req.scope)
144
+
; ("scope", `String expanded_scopes)
139
145
; ("sub", `String did) ] ) ) ) ) )
140
146
| "refresh_token" -> (
141
147
match req.refresh_token with
+2
-21
pegasus/lib/api/server/refreshSession.ml
+2
-21
pegasus/lib/api/server/refreshSession.ml
···
10
10
failwith "non-refresh auth"
11
11
in
12
12
let%lwt () = Data_store.revoke_token ~did ~jti db in
13
-
let%lwt
14
-
{ handle
15
-
; did
16
-
; email
17
-
; email_auth_factor
18
-
; email_confirmed
19
-
; active
20
-
; status
21
-
; _ } =
22
-
Auth.get_session_info did db
23
-
in
13
+
let%lwt {handle; did; active; status; _} = Auth.get_session_info did db in
24
14
let access_jwt, refresh_jwt = Jwt.generate_jwt did in
25
15
Dream.json @@ Yojson.Safe.to_string
26
16
@@ output_to_yojson
27
-
{ access_jwt
28
-
; refresh_jwt
29
-
; handle
30
-
; did
31
-
; email
32
-
; email_auth_factor
33
-
; email_confirmed
34
-
; active
35
-
; status
36
-
; did_doc= None } )
17
+
{access_jwt; refresh_jwt; handle; did; active; status; did_doc= None} )
+118
pegasus/lib/lexicon_resolver.ml
+118
pegasus/lib/lexicon_resolver.ml
···
1
+
type permission =
2
+
{ resource: string
3
+
; lxm: string list option [@default None]
4
+
; aud: string option [@default None]
5
+
; inherit_aud: bool option [@key "inheritAud"] [@default None]
6
+
; collection: string list option [@default None]
7
+
; action: string list option [@default None]
8
+
; accept: string list option [@default None] }
9
+
[@@deriving yojson {strict= false}]
10
+
11
+
type permission_set =
12
+
{ title: string option [@default None]
13
+
; title_lang: (string * string) list option [@default None]
14
+
; detail: string option [@default None]
15
+
; detail_lang: (string * string) list option [@default None]
16
+
; permissions: permission list }
17
+
[@@deriving yojson {strict= false}]
18
+
19
+
type lexicon_value =
20
+
{ type_: string [@key "$type"]
21
+
; title: string option [@default None]
22
+
; detail: string option [@default None]
23
+
; permissions: permission list option [@default None] }
24
+
[@@deriving yojson {strict= false}]
25
+
26
+
let cache : permission_set Ttl_cache.String_cache.t =
27
+
Ttl_cache.String_cache.create (3 * Util.hour) ()
28
+
29
+
(* reuse dns client from id_resolver *)
30
+
let dns_client = Id_resolver.Handle.dns_client
31
+
32
+
(* resolve did authority for nsid *)
33
+
let resolve_did_authority nsid =
34
+
let authority = Util.nsid_authority nsid in
35
+
try%lwt
36
+
let%lwt result =
37
+
Dns_client_lwt.getaddrinfo dns_client Dns.Rr_map.Txt
38
+
(Domain_name.of_string_exn ("_lexicon." ^ authority))
39
+
in
40
+
match result with
41
+
| Ok (_, t) -> (
42
+
let txt = Dns.Rr_map.Txt_set.choose t in
43
+
match String.split_on_char '=' txt with
44
+
| ["did"; did]
45
+
when String.starts_with ~prefix:"did:plc:" did
46
+
|| String.starts_with ~prefix:"did:web:" did ->
47
+
Lwt.return_ok (String.trim did)
48
+
| _ ->
49
+
Lwt.return_error "invalid did in dns record" )
50
+
| Error (`Msg e) ->
51
+
Lwt.return_error e
52
+
with exn -> Lwt.return_error (Printexc.to_string exn)
53
+
54
+
(* fetch lexicon document from authority's repo *)
55
+
let fetch_lexicon ~did ~nsid =
56
+
try%lwt
57
+
match%lwt Id_resolver.Did.resolve did with
58
+
| Error e ->
59
+
Lwt.return_error ("failed to resolve DID: " ^ e)
60
+
| Ok doc -> (
61
+
match Id_resolver.Did.Document.get_service doc "#atproto_pds" with
62
+
| None ->
63
+
Lwt.return_error "no PDS service in DID document"
64
+
| Some pds -> (
65
+
let client = Hermes.make_client ~service:pds () in
66
+
try%lwt
67
+
let%lwt record =
68
+
Lexicons.([%xrpc get "com.atproto.repo.getRecord"])
69
+
~repo:did ~collection:"com.atproto.lexicon.schema" ~rkey:nsid
70
+
client
71
+
in
72
+
Lwt.return_ok record.value
73
+
with _ -> Lwt.return_error ("failed to fetch lexicon record " ^ nsid)
74
+
) )
75
+
with exn -> Lwt.return_error (Printexc.to_string exn)
76
+
77
+
(* parse lexicon record into permission_set *)
78
+
let parse_permission_set record =
79
+
match lexicon_value_of_yojson record with
80
+
| Error e ->
81
+
Error ("failed to parse lexicon record: " ^ e)
82
+
| Ok record -> (
83
+
if record.type_ <> "permission-set" then
84
+
Error ("not a permission-set lexicon: " ^ record.type_)
85
+
else
86
+
match record.permissions with
87
+
| None ->
88
+
Error "permission-set has no permissions"
89
+
| Some permissions ->
90
+
Ok
91
+
{ title= record.title
92
+
; title_lang= None (* skip localized titles for now *)
93
+
; detail= record.detail
94
+
; detail_lang= None (* skip localized details for now *)
95
+
; permissions } )
96
+
97
+
(* resolve and parse permission set from nsid *)
98
+
let resolve nsid =
99
+
match Ttl_cache.String_cache.get cache nsid with
100
+
| Some cached ->
101
+
Lwt.return_ok cached
102
+
| None -> (
103
+
match%lwt resolve_did_authority nsid with
104
+
| Error e ->
105
+
Lwt.return_error ("DNS resolution failed: " ^ e)
106
+
| Ok did -> (
107
+
match%lwt fetch_lexicon ~did ~nsid with
108
+
| Error e ->
109
+
Lwt.return_error ("lexicon fetch failed: " ^ e)
110
+
| Ok json -> (
111
+
match parse_permission_set json with
112
+
| Error e ->
113
+
Lwt.return_error e
114
+
| Ok ps ->
115
+
Ttl_cache.String_cache.set cache nsid ps ;
116
+
Lwt.return_ok ps ) ) )
117
+
118
+
let clear_cache nsid = Ttl_cache.String_cache.remove cache nsid
+252
-45
pegasus/lib/oauth/scopes.ml
+252
-45
pegasus/lib/oauth/scopes.ml
···
1
-
type account_attr = Email | Repo | Status
1
+
type account_attr = Email | Repo
2
2
3
3
type account_action = Read | Manage
4
4
···
36
36
37
37
type blob_permission = {accept: accept_pattern list}
38
38
39
+
type include_scope = {nsid: string; aud: string option}
40
+
39
41
type static_scope =
40
42
| Atproto
41
43
| TransitionEmail
···
49
51
| Repo of repo_permission
50
52
| Rpc of rpc_permission
51
53
| Blob of blob_permission
54
+
| Include of include_scope
52
55
53
56
let is_valid_nsid s =
54
57
let segments = String.split_on_char '.' s in
···
64
67
in
65
68
List.length segments >= 3 && List.for_all valid_segment segments
66
69
70
+
(* check if permission_nsid is under include_nsid's authority *)
71
+
let is_parent_authority_of ~include_nsid ~permission_nsid =
72
+
let include_authority = Util.nsid_authority include_nsid in
73
+
let permission_authority = Util.nsid_authority permission_nsid in
74
+
String.equal include_authority permission_authority
75
+
|| String.starts_with ~prefix:(include_authority ^ ".") permission_authority
76
+
67
77
let parse_params s =
68
78
if s = "" then []
69
79
else
···
124
134
Some Email
125
135
| "repo" ->
126
136
Some Repo
127
-
| "status" ->
128
-
Some Status
129
137
| _ ->
130
138
None
131
139
···
182
190
else None
183
191
184
192
let parse_repo_permission positional params =
185
-
let collection_strs =
186
-
match positional with
187
-
| Some p ->
188
-
[p]
189
-
| None ->
190
-
get_all_params "collection" params
191
-
in
192
-
if collection_strs = [] then None
193
+
(* duplicate positional and query parameters not allowed *)
194
+
let has_collection_param = get_all_params "collection" params <> [] in
195
+
if positional <> None && has_collection_param then None
193
196
else
194
-
let collections = List.filter_map parse_repo_collection collection_strs in
195
-
if collections = [] then None
197
+
let collection_strs =
198
+
match positional with
199
+
| Some p ->
200
+
[p]
201
+
| None ->
202
+
get_all_params "collection" params
203
+
in
204
+
if collection_strs = [] then None
196
205
else
197
-
let action_strs = get_all_params "action" params in
198
-
let actions =
199
-
if action_strs = [] then all_repo_actions
200
-
else List.filter_map parse_repo_action action_strs
201
-
in
202
-
if actions = [] then None else Some {collections; actions}
206
+
let collections = List.filter_map parse_repo_collection collection_strs in
207
+
if collections = [] then None
208
+
else
209
+
let action_strs = get_all_params "action" params in
210
+
let actions =
211
+
if action_strs = [] then all_repo_actions
212
+
else List.filter_map parse_repo_action action_strs
213
+
in
214
+
if actions = [] then None else Some {collections; actions}
203
215
204
216
let parse_rpc_lxm s =
205
217
if s = "*" then Some AnyLxm
···
224
236
else None
225
237
226
238
let parse_rpc_permission positional params =
227
-
let lxm_strs =
228
-
match positional with Some p -> [p] | None -> get_all_params "lxm" params
229
-
in
230
-
if lxm_strs = [] then None
239
+
(* duplicate positional and query parameters not allowed *)
240
+
let has_lxm_param = get_all_params "lxm" params <> [] in
241
+
if positional <> None && has_lxm_param then None
231
242
else
232
-
let lxms = List.filter_map parse_rpc_lxm lxm_strs in
233
-
if lxms = [] then None
243
+
let lxm_strs =
244
+
match positional with
245
+
| Some p ->
246
+
[p]
247
+
| None ->
248
+
get_all_params "lxm" params
249
+
in
250
+
if lxm_strs = [] then None
234
251
else
235
-
match get_single_param "aud" params with
236
-
| None ->
237
-
None (* aud is required *)
238
-
| Some aud_str -> (
239
-
match parse_rpc_aud aud_str with
252
+
let lxms = List.filter_map parse_rpc_lxm lxm_strs in
253
+
if lxms = [] then None
254
+
else
255
+
match get_single_param "aud" params with
240
256
| None ->
241
-
None
242
-
| Some aud ->
243
-
(* rpc:*?aud=* is forbidden *)
244
-
if aud = AnyAud && List.mem AnyLxm lxms then None
245
-
else Some {lxm= lxms; aud} )
257
+
None (* aud is required *)
258
+
| Some aud_str -> (
259
+
match parse_rpc_aud aud_str with
260
+
| None ->
261
+
None
262
+
| Some aud ->
263
+
(* rpc:*?aud=* is forbidden *)
264
+
if aud = AnyAud && List.mem AnyLxm lxms then None
265
+
else Some {lxm= lxms; aud} )
246
266
247
267
let parse_accept_pattern s =
248
268
if s = "*/*" then Some AnyMime
···
260
280
None
261
281
262
282
let parse_blob_permission positional params =
263
-
let accept_strs =
264
-
match positional with
265
-
| Some p ->
266
-
[p]
267
-
| None ->
268
-
get_all_params "accept" params
269
-
in
270
-
if accept_strs = [] then None
283
+
(* duplicate positional and query parameters not allowed *)
284
+
let has_accept_param = get_all_params "accept" params <> [] in
285
+
if positional <> None && has_accept_param then None
271
286
else
272
-
let accepts = List.filter_map parse_accept_pattern accept_strs in
273
-
if accepts = [] then None else Some {accept= accepts}
287
+
let accept_strs =
288
+
match positional with
289
+
| Some p ->
290
+
[p]
291
+
| None ->
292
+
get_all_params "accept" params
293
+
in
294
+
if accept_strs = [] then None
295
+
else
296
+
let accepts = List.filter_map parse_accept_pattern accept_strs in
297
+
if accepts = [] then None else Some {accept= accepts}
298
+
299
+
let parse_include_scope positional params =
300
+
match positional with
301
+
| None ->
302
+
None
303
+
| Some nsid -> (
304
+
if not (is_valid_nsid nsid) then None
305
+
else
306
+
let aud = get_single_param "aud" params in
307
+
(* validate aud if present *)
308
+
match aud with
309
+
| Some a when not (is_valid_atproto_audience a) ->
310
+
None
311
+
| _ ->
312
+
Some {nsid; aud} )
274
313
275
314
let parse_static_scope = function
276
315
| "atproto" ->
···
305
344
Option.map (fun p -> Rpc p) (parse_rpc_permission positional params)
306
345
| "blob" ->
307
346
Option.map (fun p -> Blob p) (parse_blob_permission positional params)
347
+
| "include" ->
348
+
Option.map
349
+
(fun p -> Include p)
350
+
(parse_include_scope positional params)
308
351
| _ ->
309
352
None )
310
353
···
457
500
then true
458
501
else allows_rpc scopes opts
459
502
end
503
+
504
+
(* convert a permission from permission set to scope string *)
505
+
let permission_to_scope ~include_aud (perm : Lexicon_resolver.permission) =
506
+
match perm.resource with
507
+
| "rpc" -> (
508
+
match perm.lxm with
509
+
| None | Some [] ->
510
+
None
511
+
| Some lxms -> (
512
+
let aud =
513
+
match perm.aud with
514
+
| Some a ->
515
+
Some a
516
+
| None ->
517
+
if Option.value perm.inherit_aud ~default:false then include_aud
518
+
else None
519
+
in
520
+
match aud with
521
+
| None ->
522
+
None (* rpc requires aud *)
523
+
| Some a ->
524
+
Some
525
+
(List.map
526
+
(fun lxm ->
527
+
Printf.sprintf "rpc:%s?aud=%s" lxm (Uri.pct_encode a) )
528
+
lxms ) ) )
529
+
| "repo" -> (
530
+
match perm.collection with
531
+
| None | Some [] ->
532
+
None
533
+
| Some collections ->
534
+
let actions =
535
+
Option.value perm.action ~default:["create"; "update"; "delete"]
536
+
in
537
+
let action_str =
538
+
let action_set = List.sort String.compare actions in
539
+
let default_set = ["create"; "delete"; "update"] in
540
+
if action_set = default_set then ""
541
+
else "?action=" ^ String.concat "," actions
542
+
in
543
+
Some
544
+
(List.map
545
+
(fun coll -> Printf.sprintf "repo:%s%s" coll action_str)
546
+
collections ) )
547
+
| "blob" -> (
548
+
match perm.accept with
549
+
| None | Some [] ->
550
+
None
551
+
| Some accepts ->
552
+
Some (List.map (fun accept -> Printf.sprintf "blob:%s" accept) accepts)
553
+
)
554
+
| "account" | "identity" ->
555
+
(* account and identity permissions can't be granted via permission sets *)
556
+
None
557
+
| _ ->
558
+
None
559
+
560
+
(* expand include scope to list of granular scopes,
561
+
validating authority for each permission nsid & applying inheritAud *)
562
+
let expand_include_scope (inc : include_scope)
563
+
(ps : Lexicon_resolver.permission_set) =
564
+
let allowed_resources = ["rpc"; "repo"] in
565
+
ps.permissions
566
+
|> List.filter (fun (p : Lexicon_resolver.permission) ->
567
+
List.mem p.resource allowed_resources )
568
+
|> List.filter_map (fun (p : Lexicon_resolver.permission) ->
569
+
let nsids_to_check =
570
+
match p.resource with
571
+
| "rpc" ->
572
+
Option.value p.lxm ~default:[]
573
+
| "repo" ->
574
+
(* filter out wildcards from collection validation *)
575
+
Option.value p.collection ~default:[]
576
+
|> List.filter (fun c -> c <> "*" && is_valid_nsid c)
577
+
| _ ->
578
+
[]
579
+
in
580
+
let all_valid =
581
+
List.for_all
582
+
(fun nsid ->
583
+
is_parent_authority_of ~include_nsid:inc.nsid ~permission_nsid:nsid )
584
+
nsids_to_check
585
+
in
586
+
if all_valid then permission_to_scope ~include_aud:inc.aud p else None )
587
+
|> List.flatten
588
+
589
+
(* expand all scopes, resolving includes, to expanded scope string *)
590
+
let expand_scopes (scopes : scope list) : string list Lwt.t =
591
+
let%lwt expanded =
592
+
Lwt_list.map_p
593
+
(fun scope ->
594
+
match scope with
595
+
| Include inc -> (
596
+
match%lwt Lexicon_resolver.resolve inc.nsid with
597
+
| Error e ->
598
+
Logs.warn (fun l ->
599
+
l "failed to resolve permission set %s: %s" inc.nsid e ) ;
600
+
Lwt.return []
601
+
| Ok ps ->
602
+
Lwt.return (expand_include_scope inc ps) )
603
+
| Static Atproto ->
604
+
Lwt.return ["atproto"]
605
+
| Static TransitionEmail ->
606
+
Lwt.return ["transition:email"]
607
+
| Static TransitionGeneric ->
608
+
Lwt.return ["transition:generic"]
609
+
| Static TransitionChatBsky ->
610
+
Lwt.return ["transition:chat.bsky"]
611
+
| Account perm ->
612
+
let attr_str =
613
+
match perm.attr with Email -> "email" | Repo -> "repo"
614
+
in
615
+
let actions_str =
616
+
if List.mem Manage perm.actions then "?action=manage" else ""
617
+
in
618
+
Lwt.return [Printf.sprintf "account:%s%s" attr_str actions_str]
619
+
| Identity perm ->
620
+
let attr_str =
621
+
match perm.attr with Handle -> "handle" | Any -> "*"
622
+
in
623
+
Lwt.return [Printf.sprintf "identity:%s" attr_str]
624
+
| Repo perm ->
625
+
let colls =
626
+
List.map
627
+
(function All -> "*" | Collection c -> c)
628
+
perm.collections
629
+
in
630
+
let actions = List.map show_repo_action perm.actions in
631
+
let action_str =
632
+
if actions = ["create"; "update"; "delete"] then ""
633
+
else "?action=" ^ String.concat "," actions
634
+
in
635
+
Lwt.return
636
+
(List.map
637
+
(fun c -> Printf.sprintf "repo:%s%s" c action_str)
638
+
colls )
639
+
| Rpc perm ->
640
+
let lxms =
641
+
List.map (function AnyLxm -> "*" | Lxm l -> l) perm.lxm
642
+
in
643
+
let aud_str = match perm.aud with AnyAud -> "*" | Aud a -> a in
644
+
Lwt.return
645
+
(List.map
646
+
(fun l ->
647
+
Printf.sprintf "rpc:%s?aud=%s" l (Uri.pct_encode aud_str) )
648
+
lxms )
649
+
| Blob perm ->
650
+
let accepts =
651
+
List.map
652
+
(function
653
+
| AnyMime ->
654
+
"*/*"
655
+
| TypeWildcard t ->
656
+
t ^ "/*"
657
+
| ExactMime (t, s) ->
658
+
t ^ "/" ^ s )
659
+
perm.accept
660
+
in
661
+
Lwt.return (List.map (fun a -> Printf.sprintf "blob:%s" a) accepts) )
662
+
scopes
663
+
in
664
+
Lwt.return (List.flatten expanded |> List.sort_uniq String.compare)
665
+
666
+
let scopes_to_string scopes = String.concat " " scopes
+7
pegasus/lib/util.ml
+7
pegasus/lib/util.ml
···
551
551
Printf.sprintf "at://%s/%s/%s%s" repo collection rkey
552
552
(Option.value ~default:"" fragment)
553
553
554
+
let nsid_authority nsid =
555
+
match String.rindex_opt nsid '.' with
556
+
| None ->
557
+
nsid
558
+
| Some idx ->
559
+
String.sub nsid 0 idx
560
+
554
561
let send_email_or_log ~(recipients : Letters.recipient list) ~subject
555
562
~(body : Letters.body) =
556
563
let log_email () =
+2
-2
pegasus/test/dune
+2
-2
pegasus/test/dune
+177
pegasus/test/test_scopes.ml
+177
pegasus/test/test_scopes.ml
···
1
+
open Alcotest
2
+
open Pegasus.Oauth.Scopes
3
+
4
+
let test_string = testable Fmt.string String.equal
5
+
6
+
let test_nsid_authority () =
7
+
check test_string "three segments" "com.example"
8
+
(Pegasus.Util.nsid_authority "com.example.foo") ;
9
+
check test_string "four segments" "com.example.app"
10
+
(Pegasus.Util.nsid_authority "com.example.app.auth") ;
11
+
check test_string "two segments" "com"
12
+
(Pegasus.Util.nsid_authority "com.example")
13
+
14
+
let test_is_parent_authority () =
15
+
check bool "same authority" true
16
+
(is_parent_authority_of ~include_nsid:"com.example.app.auth"
17
+
~permission_nsid:"com.example.app.calendar" ) ;
18
+
check bool "child authority" true
19
+
(is_parent_authority_of ~include_nsid:"com.example.app.auth"
20
+
~permission_nsid:"com.example.app.sub.thing" ) ;
21
+
check bool "different authority" false
22
+
(is_parent_authority_of ~include_nsid:"com.example.app.auth"
23
+
~permission_nsid:"org.other.thing" ) ;
24
+
check bool "partial match not ok" false
25
+
(is_parent_authority_of ~include_nsid:"com.example.app.auth"
26
+
~permission_nsid:"com.example.different" )
27
+
28
+
(* test parse_scope for include scopes *)
29
+
let test_parse_include_scope () =
30
+
(* valid include scope with aud *)
31
+
( match
32
+
parse_scope "include:com.example.app.auth?aud=did:web:api.example.com"
33
+
with
34
+
| Some (Include {nsid; aud}) ->
35
+
check test_string "nsid" "com.example.app.auth" nsid ;
36
+
check (option test_string) "aud" (Some "did:web:api.example.com") aud
37
+
| _ ->
38
+
fail "expected Include scope" ) ;
39
+
(* valid include scope without aud *)
40
+
( match parse_scope "include:com.example.app.perms" with
41
+
| Some (Include {nsid; aud}) ->
42
+
check test_string "nsid" "com.example.app.perms" nsid ;
43
+
check (option test_string) "aud" None aud
44
+
| _ ->
45
+
fail "expected Include scope" ) ;
46
+
(* bad nsid *)
47
+
( match parse_scope "include:invalid" with
48
+
| None ->
49
+
()
50
+
| Some _ ->
51
+
fail "expected None for invalid nsid" ) ;
52
+
(* bad aud *)
53
+
match parse_scope "include:com.example.foo?aud=notadid" with
54
+
| None ->
55
+
()
56
+
| Some _ ->
57
+
fail "expected None for invalid aud"
58
+
59
+
let test_permission_to_scope () =
60
+
let open Pegasus.Lexicon_resolver in
61
+
(* rpc permission with explicit aud *)
62
+
let rpc_perm =
63
+
{ resource= "rpc"
64
+
; lxm= Some ["com.example.foo"; "com.example.bar"]
65
+
; aud= Some "did:web:api.example.com"
66
+
; inherit_aud= None
67
+
; collection= None
68
+
; action= None
69
+
; accept= None }
70
+
in
71
+
( match permission_to_scope ~include_aud:None rpc_perm with
72
+
| Some scopes ->
73
+
check int "two rpc scopes" 2 (List.length scopes) ;
74
+
(* check that first scope starts with expected pattern *)
75
+
check bool "first scope valid" true
76
+
(String.starts_with ~prefix:"rpc:com.example.foo?aud="
77
+
(List.nth scopes 0) )
78
+
| None ->
79
+
fail "expected Some scopes" ) ;
80
+
(* rpc permission with inheritAud *)
81
+
let rpc_inherit =
82
+
{ resource= "rpc"
83
+
; lxm= Some ["com.example.baz"]
84
+
; aud= None
85
+
; inherit_aud= Some true
86
+
; collection= None
87
+
; action= None
88
+
; accept= None }
89
+
in
90
+
( match
91
+
permission_to_scope ~include_aud:(Some "did:plc:inherited") rpc_inherit
92
+
with
93
+
| Some scopes ->
94
+
check int "inherited aud single scope" 1 (List.length scopes) ;
95
+
check bool "inherited aud scope valid" true
96
+
(String.starts_with ~prefix:"rpc:com.example.baz?aud="
97
+
(List.nth scopes 0) )
98
+
| None ->
99
+
fail "expected scopes with inherited aud" ) ;
100
+
(* repo permission included *)
101
+
let repo_perm =
102
+
{ resource= "repo"
103
+
; lxm= None
104
+
; aud= None
105
+
; inherit_aud= None
106
+
; collection= Some ["com.example.data"]
107
+
; action= Some ["create"; "update"]
108
+
; accept= None }
109
+
in
110
+
( match permission_to_scope ~include_aud:None repo_perm with
111
+
| Some [scope] ->
112
+
check bool "repo scope" true
113
+
(String.starts_with ~prefix:"repo:com.example.data" scope)
114
+
| _ ->
115
+
fail "expected single repo scope" ) ;
116
+
(* account permission filtered out *)
117
+
let account_perm =
118
+
{ resource= "account"
119
+
; lxm= None
120
+
; aud= None
121
+
; inherit_aud= None
122
+
; collection= None
123
+
; action= None
124
+
; accept= None }
125
+
in
126
+
match permission_to_scope ~include_aud:None account_perm with
127
+
| None ->
128
+
()
129
+
| Some _ ->
130
+
fail "account should be filtered"
131
+
132
+
let test_expand_include_scope_authority () =
133
+
let open Pegasus.Lexicon_resolver in
134
+
let inc : include_scope =
135
+
{nsid= "com.example.app.auth"; aud= Some "did:web:api.example.com"}
136
+
in
137
+
let ps =
138
+
{ title= Some "Test"
139
+
; title_lang= None
140
+
; detail= None
141
+
; detail_lang= None
142
+
; permissions=
143
+
[ (* valid under com.example.app authority *)
144
+
{ resource= "rpc"
145
+
; lxm= Some ["com.example.app.login"]
146
+
; aud= None
147
+
; inherit_aud= Some true
148
+
; collection= None
149
+
; action= None
150
+
; accept= None }
151
+
; (* invalid, different authority *)
152
+
{ resource= "rpc"
153
+
; lxm= Some ["org.other.thing"]
154
+
; aud= None
155
+
; inherit_aud= Some true
156
+
; collection= None
157
+
; action= None
158
+
; accept= None } ] }
159
+
in
160
+
let expanded = expand_include_scope inc ps in
161
+
check int "only valid permission expanded" 1 (List.length expanded) ;
162
+
(* check that we have at least one scope starting with rpc: *)
163
+
check bool "has rpc scope" true
164
+
( List.length expanded > 0
165
+
&& String.starts_with ~prefix:"rpc:" (List.hd expanded) )
166
+
167
+
let () =
168
+
run "scopes"
169
+
[ ( "authority"
170
+
, [ ("nsid_authority", `Quick, test_nsid_authority)
171
+
; ("is_parent_authority_of", `Quick, test_is_parent_authority) ] )
172
+
; ("include", [("parse_include_scope", `Quick, test_parse_include_scope)])
173
+
; ( "expansion"
174
+
, [ ("permission_to_scope", `Quick, test_permission_to_scope)
175
+
; ( "expand_include_scope_authority"
176
+
, `Quick
177
+
, test_expand_include_scope_authority ) ] ) ]