objective categorical abstract machine language personal data server
1[@@@ocaml.warning "-26-27"]
2
3open Melange_json.Primitives
4open React
5module Aria = ReactAria
6
7let cimd_suffix_len = String.length "/oauth-client-metadata.json"
8
9type actor = AccountSwitcher.actor =
10 {did: string; handle: string; avatar_data_uri: string option [@default None]}
11[@@deriving json]
12
13type 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
20type props =
21 { client_url: string * string (* (host, path) *)
22 ; client_name: string option [@default None]
23 ; logo_uri: string option [@default None]
24 ; current_user: actor
25 ; logged_in_users: actor list
26 ; scopes: string list
27 ; permission_sets: permission_set_display list [@default []]
28 ; code: string
29 ; request_uri: string
30 ; csrf_token: string }
31[@@deriving json]
32
33module ScopesTable = struct
34 type repo_action = Create | Update | Delete
35
36 type parsed_repo_scope = {collections: string list; actions: repo_action list}
37
38 type parsed_rpc_scope = {lxm: string; aud: string}
39
40 type parsed_scope =
41 | Email of [`Read | `Manage]
42 | Identity of [`Handle | `Full]
43 | Repo of parsed_repo_scope
44 | Rpc of parsed_rpc_scope
45 | Blob of string list (* mimetypes *)
46 | Bluesky (* transition:generic or app.bsky.* *)
47 | Chat (* transition:chat.bsky or chat.bsky.* *)
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 *) }
54 | Unknown of string
55
56 let parse_scope scope =
57 if scope = "atproto" then Atproto
58 else if scope = "transition:generic" then Bluesky
59 else if scope = "transition:chat.bsky" then Chat
60 else if scope = "transition:email" then Email `Read
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
118 let rest = String.sub scope 9 (String.length scope - 9) in
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
150 let rest = String.sub scope 5 (String.length scope - 5) in
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
178 let collection =
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 )
187 in
188 let actions =
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
210 in
211 if
212 List.exists
213 (fun c ->
214 String.starts_with ~prefix:"app.bsky." c
215 || String.starts_with ~prefix:"chat.bsky." c )
216 collection
217 then
218 if
219 List.exists
220 (fun c -> String.starts_with ~prefix:"chat.bsky." c)
221 collection
222 then Chat
223 else Bluesky
224 else Repo {collections= collection; actions}
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
230 let rest = String.sub scope 4 (String.length scope - 4) in
231 let parts = String.split_on_char '?' rest 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
265 let aud =
266 List.find_map (fun (k, v) -> if k = "aud" then Some v else None) params
267 |> Option.value ~default:"*"
268 in
269 if String.starts_with ~prefix:"app.bsky." lxm then Bluesky
270 else if String.starts_with ~prefix:"chat.bsky." lxm then Chat
271 else Rpc {lxm; aud}
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
277 let rest = String.sub scope 5 (String.length scope - 5) in
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)
290 else Unknown scope
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
360 type collection_actions = {create: bool; update: bool; delete: bool}
361
362 module StringMap = Map.Make (String)
363
364 let build_collection_actions_map repos =
365 List.fold_left
366 (fun acc r ->
367 List.fold_left
368 (fun acc coll ->
369 let existing =
370 StringMap.find_opt coll acc
371 |> Option.value
372 ~default:{create= false; update= false; delete= false}
373 in
374 let updated =
375 { create= existing.create || List.mem Create r.actions
376 ; update= existing.update || List.mem Update r.actions
377 ; delete= existing.delete || List.mem Delete r.actions }
378 in
379 StringMap.add coll updated acc )
380 acc r.collections )
381 StringMap.empty repos
382
383 let build_aud_lxms_map rpcs =
384 List.fold_left
385 (fun acc r ->
386 let existing =
387 StringMap.find_opt r.aud acc |> Option.value ~default:[]
388 in
389 let lxms =
390 if List.mem r.lxm existing then existing else r.lxm :: existing
391 in
392 StringMap.add r.aud lxms acc )
393 StringMap.empty rpcs
394
395 let merge_parsed_scopes scopes =
396 let email = ref None in
397 let identity = ref None in
398 let repos = ref [] in
399 let rpcs = ref [] in
400 let blobs = ref [] in
401 let has_bluesky = ref false in
402 let has_chat = ref false in
403 let unknowns = ref [] in
404 List.iter
405 (fun scope ->
406 match parse_scope scope with
407 | Email `Manage ->
408 email := Some `Manage
409 | Email `Read ->
410 if !email = None then email := Some `Read
411 | Identity `Full ->
412 identity := Some `Full
413 | Identity `Handle ->
414 if !identity = None then identity := Some `Handle
415 | Repo r ->
416 repos := r :: !repos
417 | Rpc r ->
418 rpcs := r :: !rpcs
419 | Blob mimes ->
420 blobs := mimes @ !blobs
421 | Bluesky ->
422 has_bluesky := true
423 | Chat ->
424 has_chat := true
425 | Atproto ->
426 ()
427 | PermissionSet _ ->
428 ()
429 | Unknown s ->
430 unknowns := s :: !unknowns )
431 scopes ;
432 ( !email
433 , !identity
434 , !repos
435 , !rpcs
436 , !blobs
437 , !has_bluesky
438 , !has_chat
439 , !unknowns )
440
441 let[@react.component] make ~scopes ?(permission_sets = []) () =
442 let email, identity, repos, rpcs, blobs, has_bluesky, has_chat, unknowns =
443 merge_parsed_scopes scopes
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
455 <div className="w-full mt-3 space-y-1">
456 ( match email with
457 | Some level ->
458 <div className="flex items-start gap-3 p-3 rounded-lg">
459 <div
460 className="flex-shrink-0 w-8 h-8 flex items-center \
461 justify-center rounded-full bg-mist-20/50 \
462 text-mist-80">
463 <MailIcon className="w-4 h-4" />
464 </div>
465 <div className="flex-1 min-w-0">
466 <div className="font-serif text-mana-100">(string "email")</div>
467 <div className="text-sm text-mist-100">
468 (string
469 ( if level = `Manage then
470 "Read and update your account's email address"
471 else "Read your account's email address" ) )
472 </div>
473 </div>
474 </div>
475 | None ->
476 null )
477 ( match identity with
478 | Some level ->
479 <div className="flex items-start gap-3 p-3">
480 <div
481 className="flex-shrink-0 w-8 h-8 flex items-center \
482 justify-center rounded-full bg-mist-20/50 \
483 text-mist-80">
484 <AtIcon className="w-4 h-4" />
485 </div>
486 <div className="flex-1 min-w-0">
487 <div className="font-serif text-mana-100">
488 (string "identity")
489 </div>
490 <div className="text-sm text-mist-100">
491 (string
492 ( if level = `Full then
493 "Manage your full identity including your @handle, with \
494 the ability to move your account to another PDS or \
495 permanently lock you out of your account."
496 else "Change your @handle" ) )
497 </div>
498 </div>
499 </div>
500 | None ->
501 null )
502 ( if has_bluesky then
503 <div className="flex items-start gap-3 p-3 rounded-lg">
504 <div
505 className="flex-shrink-0 w-8 h-8 flex items-center \
506 justify-center rounded-full bg-mist-20/50 \
507 text-mist-80">
508 <BlueskyIcon className="w-4 h-4" />
509 </div>
510 <div className="flex-1 min-w-0">
511 <div className="font-serif text-mana-100">(string "bluesky")</div>
512 <div className="text-sm text-mist-100">
513 (string "Manage your profile, posts, likes and follows")
514 </div>
515 </div>
516 </div>
517 else null )
518 ( if has_chat then
519 <div className="flex items-start gap-3 p-3 rounded-lg">
520 <div
521 className="flex-shrink-0 w-8 h-8 flex items-center \
522 justify-center rounded-full bg-mist-20/50 \
523 text-mist-80">
524 <MessageIcon className="w-4 h-4" />
525 </div>
526 <div className="flex-1 min-w-0">
527 <div className="font-serif text-mana-100">(string "chat")</div>
528 <div className="text-sm text-mist-100">
529 (string "Read and send messages")
530 </div>
531 </div>
532 </div>
533 else null )
534 ( if List.length repos > 0 then
535 let coll_actions_map = build_collection_actions_map repos in
536 let coll_actions_list =
537 StringMap.bindings coll_actions_map
538 |> List.sort (fun (a, _) (b, _) -> String.compare a b)
539 in
540 let star_actions = StringMap.find_opt "*" coll_actions_map in
541 let has_full_access =
542 match star_actions with
543 | Some a ->
544 a.create && a.update && a.delete
545 | None ->
546 false
547 in
548 <div className="flex items-start gap-3 p-3 rounded-lg">
549 <div
550 className="flex-shrink-0 w-8 h-8 flex items-center \
551 justify-center rounded-full bg-mist-20/50 \
552 text-mist-80">
553 <FolderGitIcon className="w-4 h-4" />
554 </div>
555 <div className="flex-1 min-w-0">
556 <div className="font-serif text-mana-100">
557 (string "repository")
558 </div>
559 <div className="text-sm text-mist-100">
560 (string
561 ( if has_full_access then
562 "Create, update, and delete any public record"
563 else "Publish changes to your repository" ) )
564 </div>
565 ( if not has_full_access then
566 <table className="w-full mt-2 text-xs">
567 <thead>
568 <tr className="text-mist-80">
569 <th className="text-left font-normal pb-1">
570 (string "Collection")
571 </th>
572 <th className="text-center font-normal pb-1 w-16">
573 (string "Create")
574 </th>
575 <th className="text-center font-normal pb-1 w-16">
576 (string "Update")
577 </th>
578 <th className="text-center font-normal pb-1 w-16">
579 (string "Delete")
580 </th>
581 </tr>
582 </thead>
583 <tbody>
584 ( coll_actions_list
585 |> List.map (fun (coll, actions) ->
586 let star_create =
587 Option.map (fun a -> a.create) star_actions
588 |> Option.value ~default:false
589 in
590 let star_update =
591 Option.map (fun a -> a.update) star_actions
592 |> Option.value ~default:false
593 in
594 let star_delete =
595 Option.map (fun a -> a.delete) star_actions
596 |> Option.value ~default:false
597 in
598 <tr key=coll className="text-mist-100">
599 <td className="py-0.5">
600 <span className="font-medium">
601 (string
602 ( if coll = "*" then "Any collection"
603 else coll ) )
604 </span>
605 </td>
606 <td className="text-center">
607 ( if star_create || actions.create then
608 <span className="text-mana-100">
609 (string {js|✓|js})
610 </span>
611 else null )
612 </td>
613 <td className="text-center">
614 ( if star_update || actions.update then
615 <span className="text-mana-100">
616 (string {js|✓|js})
617 </span>
618 else null )
619 </td>
620 <td className="text-center">
621 ( if star_delete || actions.delete then
622 <span className="text-mana-100">
623 (string {js|✓|js})
624 </span>
625 else null )
626 </td>
627 </tr> )
628 |> Array.of_list |> array )
629 </tbody>
630 </table>
631 else null )
632 </div>
633 </div>
634 else null )
635 ( if List.length rpcs > 0 then
636 let aud_lxms_map = build_aud_lxms_map rpcs in
637 let aud_lxms_list =
638 StringMap.bindings aud_lxms_map
639 |> List.map (fun (aud, lxms) ->
640 let sorted_lxms =
641 if List.mem "*" lxms then ["*"]
642 else List.sort String.compare lxms
643 in
644 (aud, sorted_lxms) )
645 |> List.sort (fun (a, _) (b, _) -> String.compare a b)
646 in
647 let has_full_access =
648 List.exists
649 (fun (aud, lxms) -> aud = "*" && List.mem "*" lxms)
650 aud_lxms_list
651 in
652 <div className="flex items-start gap-3 p-3 rounded-lg">
653 <div
654 className="flex-shrink-0 w-8 h-8 flex items-center \
655 justify-center rounded-full bg-mist-20/50 \
656 text-mist-80">
657 <UsersRoundIcon className="w-4 h-4" />
658 </div>
659 <div className="flex-1 min-w-0">
660 <div className="font-serif text-mana-100">
661 (string "authenticate")
662 </div>
663 <div className="text-sm text-mist-100">
664 (string
665 ( if has_full_access then
666 "Act on your behalf towards any service"
667 else "Perform actions on your behalf" ) )
668 </div>
669 ( if not has_full_access then
670 <table className="w-full mt-2 text-xs">
671 <thead>
672 <tr className="text-mist-80">
673 <th className="text-left font-normal pb-1">
674 (string "Method")
675 </th>
676 <th className="text-left font-normal pb-1">
677 (string "Service")
678 </th>
679 </tr>
680 </thead>
681 <tbody>
682 ( aud_lxms_list
683 |> List.concat_map (fun (aud, lxms) ->
684 let render_aud () =
685 if aud = "*" then
686 <span className="text-mist-100 font-medium">
687 (string "Any service")
688 </span>
689 else if
690 String.starts_with ~prefix:"did:web:api.bsky.app#"
691 aud
692 then
693 <span className="text-mist-100" title=aud>
694 (string "Bluesky services")
695 </span>
696 else if
697 String.starts_with
698 ~prefix:"did:web:api.bsky.chat#" aud
699 then
700 <span className="text-mist-100" title=aud>
701 (string "Bluesky chat services")
702 </span>
703 else if
704 String.starts_with ~prefix:"did:web:" aud
705 && String.contains aud '#'
706 then
707 let domain =
708 String.sub aud 8 (String.index aud '#' - 8)
709 in
710 <span className="text-mist-100" title=aud>
711 (string ("Service by " ^ domain))
712 </span>
713 else
714 <span className="text-mist-100">
715 (string aud)
716 </span>
717 in
718 List.map
719 (fun lxm ->
720 <tr key=(aud ^ lxm) className="text-mist-100">
721 <td className="py-0.5">
722 <span className="text-mist-100 font-medium">
723 (string
724 (if lxm = "*" then "Any method" else lxm) )
725 </span>
726 </td>
727 <td className="py-0.5">(render_aud ())</td>
728 </tr> )
729 lxms )
730 |> Array.of_list |> array )
731 </tbody>
732 </table>
733 else null )
734 </div>
735 </div>
736 else null )
737 ( if List.length blobs > 0 then
738 <div className="flex items-start gap-3 p-3 rounded-lg">
739 <div
740 className="flex-shrink-0 w-8 h-8 flex items-center \
741 justify-center rounded-full bg-mist-20/50 \
742 text-mist-80">
743 <UploadIcon className="w-4 h-4" />
744 </div>
745 <div className="flex-1 min-w-0">
746 <div className="font-serif text-mana-100">
747 (string "file upload")
748 </div>
749 <div className="text-sm text-mist-100">
750 (string
751 ( if List.mem "*/*" blobs then "Upload any files"
752 else "Upload files to your repository" ) )
753 </div>
754 </div>
755 </div>
756 else null )
757 ( if List.length unknowns > 0 then
758 <div className="flex items-start gap-3 p-3 rounded-lg">
759 <div
760 className="flex-shrink-0 w-8 h-8 flex items-center \
761 justify-center rounded-full bg-mist-20/50 \
762 text-mist-80">
763 <BoxesIcon className="w-4 h-4" />
764 </div>
765 <div className="flex-1 min-w-0">
766 <div className="font-serif text-mana-100">
767 (string "other permissions")
768 </div>
769 <div className="text-sm text-mist-100">
770 ( unknowns
771 |> List.map (fun s ->
772 <span key=s className="block">(string s)</span> )
773 |> Array.of_list |> array )
774 </div>
775 </div>
776 </div>
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 )
868 </div>
869end
870
871let[@react.component] make
872 ~props:
873 ({ client_url
874 ; client_name
875 ; logo_uri
876 ; current_user
877 ; logged_in_users
878 ; scopes
879 ; permission_sets
880 ; code
881 ; request_uri
882 ; csrf_token } :
883 props ) () =
884 let host, path = client_url in
885 let rendered_name =
886 match client_name with
887 | Some client_name ->
888 <span className="text-mana-100 font-serif">
889 (string client_name)
890 <span className="font-sans">(string (" (" ^ host ^ ")"))</span>
891 </span>
892 | None when String.length path = 0 ->
893 <span className="text-mana-100 font-serif">(string host)</span>
894 | None ->
895 <span className="text-mana-100 font-serif">
896 (string host) <span className="text-mana-40">(string path)</span>
897 </span>
898 in
899 let query_string =
900 match%platform Runtime.platform with
901 | Server ->
902 ""
903 | Client ->
904 Webapi.Dom.Location.search Webapi.Dom.location
905 in
906 let add_account_url = "/account/login" ^ query_string in
907 let favicon_url, set_favicon_url =
908 useState (fun () ->
909 Option.value logo_uri ~default:("https://" ^ host ^ "/favicon.ico") )
910 in
911 <form className="w-full h-auto max-w-lg px-4 sm:px-0 py-16 my-auto">
912 <h1 className="text-2xl font-serif text-mana-200 mb-2">
913 (string ("authorizing " ^ host))
914 </h1>
915 <span className="w-full inline text-mist-100">
916 (string "You're signing into ")
917 ( if favicon_url <> "" then
918 <img
919 src=favicon_url
920 className="w-4 h-4 inline ml-0.5 mr-1 -mt-0.5"
921 onError=(fun _ -> set_favicon_url (fun _ -> "")) />
922 else null )
923 rendered_name
924 (string " as ")
925 <AccountSwitcher current_user logged_in_users add_account_url inline=true
926 />
927 (string " and granting it the following permissions:")
928 </span>
929 <ScopesTable scopes permission_sets />
930 <div className="w-full flex flex-row items-center justify-between mt-6">
931 <input type_="hidden" name="dream.csrf" value=csrf_token />
932 <input type_="hidden" name="code" value=code />
933 <input type_="hidden" name="request_uri" value=request_uri />
934 <Button
935 kind=`Secondary
936 type_="submit"
937 formMethod="post"
938 name="action"
939 value="deny"
940 className="grow basis-1/3 min-w-0">
941 (string "cancel")
942 </Button>
943 <Button
944 kind=`Primary
945 type_="submit"
946 formMethod="post"
947 name="action"
948 value="allow"
949 className="grow basis-2/3 min-w-0 max-w-2xs">
950 (string "authorize")
951 </Button>
952 </div>
953 </form>