+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 13 + type permission_set_display = 14 14 + { nsid: string 15 15 + ; title: string option [@default None] 16 16 + ; detail: string option [@default None] 17 17 + ; expanded_scopes: string list } 18 18 + [@@deriving json] 19 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 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 49 + | PermissionSet of 50 50 + { nsid: string 51 51 + ; title: string option 52 52 + ; detail: string option 53 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 48 - else if String.starts_with ~prefix:"account:email" scope then 49 49 - if String.exists (fun c -> c = '=') scope then Email `Manage 50 50 - else Email `Read 51 51 - else if String.starts_with ~prefix:"identity:" scope then 61 61 + else if 62 62 + String.starts_with ~prefix:"account:" scope 63 63 + || String.starts_with ~prefix:"account?" scope 64 64 + then 65 65 + let has_positional = String.starts_with ~prefix:"account:" scope in 66 66 + let rest = 67 67 + String.sub scope 8 (String.length scope - 8) 68 68 + in 69 69 + let parts = String.split_on_char '?' rest in 70 70 + let positional_attr = 71 71 + if has_positional then 72 72 + match parts with a :: _ when a <> "" -> Some a | _ -> None 73 73 + else None 74 74 + in 75 75 + let query_str = 76 76 + if has_positional then 77 77 + if List.length parts > 1 then Some (List.nth parts 1) else None 78 78 + else if rest <> "" then Some rest 79 79 + else None 80 80 + in 81 81 + let parse_query_params qs = 82 82 + String.split_on_char '&' qs 83 83 + |> List.filter_map (fun pair -> 84 84 + match String.split_on_char '=' pair with 85 85 + | [k; v] -> 86 86 + Some (k, v) 87 87 + | _ -> 88 88 + None ) 89 89 + in 90 90 + let params = 91 91 + Option.map parse_query_params query_str |> Option.value ~default:[] 92 92 + in 93 93 + let attr = 94 94 + match positional_attr with 95 95 + | Some a -> 96 96 + a 97 97 + | None -> 98 98 + List.find_map 99 99 + (fun (k, v) -> if k = "attr" then Some v else None) 100 100 + params 101 101 + |> Option.value ~default:"" 102 102 + in 103 103 + let action = 104 104 + List.find_map 105 105 + (fun (k, v) -> if k = "action" then Some v else None) 106 106 + params 107 107 + |> Option.value ~default:"read" 108 108 + in 109 109 + if attr = "email" then 110 110 + if action = "manage" then Email `Manage else Email `Read 111 111 + else Unknown scope (* repo and other attrs not displayed specially *) 112 112 + else if 113 113 + String.starts_with ~prefix:"identity:" scope 114 114 + || String.starts_with ~prefix:"identity?" scope 115 115 + then 116 116 + (* attrs are "handle" or "*" *) 117 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 53 - if rest = "*" || String.starts_with ~prefix:"*" rest then Identity `Full 54 54 - else Identity `Handle 55 55 - else if String.starts_with ~prefix:"repo:" scope then 119 119 + let parts = String.split_on_char '?' rest in 120 120 + let positional_attr = 121 121 + if has_positional then 122 122 + match parts with a :: _ when a <> "" -> Some a | _ -> None 123 123 + else None 124 124 + in 125 125 + let attr = 126 126 + match positional_attr with 127 127 + | Some a -> 128 128 + a 129 129 + | None -> 130 130 + let params = 131 131 + if has_positional then 132 132 + if List.length parts > 1 then List.nth parts 1 else "" 133 133 + else rest 134 134 + in 135 135 + String.split_on_char '&' params 136 136 + |> List.find_map (fun pair -> 137 137 + match String.split_on_char '=' pair with 138 138 + | [k; v] when k = "attr" -> 139 139 + Some v 140 140 + | _ -> 141 141 + None ) 142 142 + |> Option.value ~default:"handle" 143 143 + in 144 144 + if attr = "*" then Identity `Full else Identity `Handle 145 145 + else if 146 146 + String.starts_with ~prefix:"repo:" scope 147 147 + || String.starts_with ~prefix:"repo?" scope 148 148 + then 149 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 152 + let positional_coll = 153 153 + if has_positional then 154 154 + match parts with coll :: _ when coll <> "" -> Some coll | _ -> None 155 155 + else None 156 156 + in 157 157 + let query_str = 158 158 + if has_positional then 159 159 + if List.length parts > 1 then Some (List.nth parts 1) else None 160 160 + else if 161 161 + (* for repo?... format, rest starts with the query string *) 162 162 + rest <> "" 163 163 + then Some rest 164 164 + else None 165 165 + in 166 166 + let parse_query_params qs = 167 167 + String.split_on_char '&' qs 168 168 + |> List.filter_map (fun pair -> 169 169 + match String.split_on_char '=' pair with 170 170 + | [k; v] -> 171 171 + Some (k, v) 172 172 + | _ -> 173 173 + None ) 174 174 + in 175 175 + let params = 176 176 + Option.map parse_query_params query_str |> Option.value ~default:[] 177 177 + in 58 178 let collection = 59 59 - match parts with coll :: _ when coll <> "" -> [coll] | _ -> ["*"] 179 179 + match positional_coll with 180 180 + | Some c -> 181 181 + [c] 182 182 + | None -> ( 183 183 + List.filter_map 184 184 + (fun (k, v) -> if k = "collection" then Some v else None) 185 185 + params 186 186 + |> function [] -> ["*"] | cols -> cols ) 60 187 in 61 188 let actions = 62 62 - if List.length parts > 1 then 63 63 - let params = List.nth parts 1 in 64 64 - if String.contains params '=' then 65 65 - List.filter_map 66 66 - (fun a -> 67 67 - if 68 68 - String.ends_with ~suffix:a params 69 69 - || String.contains params ',' 70 70 - then 71 71 - match a with 72 72 - | "create" -> 73 73 - Some Create 74 74 - | "update" -> 75 75 - Some Update 76 76 - | "delete" -> 77 77 - Some Delete 78 78 - | _ -> 79 79 - None 80 80 - else None ) 81 81 - ["create"; "update"; "delete"] 82 82 - |> function [] -> [Create; Update; Delete] | l -> l 83 83 - else [Create; Update; Delete] 84 84 - else [Create; Update; Delete] 189 189 + let action_strs = 190 190 + List.filter_map 191 191 + (fun (k, v) -> if k = "action" then Some v else None) 192 192 + params 193 193 + |> List.concat_map (String.split_on_char ',') 194 194 + in 195 195 + if action_strs = [] then [Create; Update; Delete] 196 196 + else 197 197 + List.filter_map 198 198 + (fun a -> 199 199 + match a with 200 200 + | "create" -> 201 201 + Some Create 202 202 + | "update" -> 203 203 + Some Update 204 204 + | "delete" -> 205 205 + Some Delete 206 206 + | _ -> 207 207 + None ) 208 208 + action_strs 209 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 100 - else if String.starts_with ~prefix:"rpc:" scope then 225 225 + else if 226 226 + String.starts_with ~prefix:"rpc:" scope 227 227 + || String.starts_with ~prefix:"rpc?" scope 228 228 + then 229 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 103 - let lxm = match parts with l :: _ -> l | [] -> "*" in 232 232 + let positional_lxm = 233 233 + if has_positional then 234 234 + match parts with l :: _ when l <> "" -> Some l | _ -> None 235 235 + else None 236 236 + in 237 237 + let query_str = 238 238 + if has_positional then 239 239 + if List.length parts > 1 then Some (List.nth parts 1) else None 240 240 + else if rest <> "" then Some rest 241 241 + else None 242 242 + in 243 243 + let parse_query_params qs = 244 244 + String.split_on_char '&' qs 245 245 + |> List.filter_map (fun pair -> 246 246 + match String.split_on_char '=' pair with 247 247 + | [k; v] -> 248 248 + Some (k, v) 249 249 + | _ -> 250 250 + None ) 251 251 + in 252 252 + let params = 253 253 + Option.map parse_query_params query_str |> Option.value ~default:[] 254 254 + in 255 255 + let lxm = 256 256 + match positional_lxm with 257 257 + | Some l -> 258 258 + l 259 259 + | None -> 260 260 + List.find_map 261 261 + (fun (k, v) -> if k = "lxm" then Some v else None) 262 262 + params 263 263 + |> Option.value ~default:"*" 264 264 + in 104 265 let aud = 105 105 - if List.length parts > 1 then 106 106 - let params = List.nth parts 1 in 107 107 - if String.starts_with ~prefix:"aud=" params then 108 108 - String.sub params 4 (String.length params - 4) 109 109 - else "*" 110 110 - else "*" 266 266 + List.find_map (fun (k, v) -> if k = "aud" then Some v else None) params 267 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 115 - else if String.starts_with ~prefix:"blob:" scope then 272 272 + else if 273 273 + String.starts_with ~prefix:"blob:" scope 274 274 + || String.starts_with ~prefix:"blob?" scope 275 275 + then 276 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 117 - Blob [rest] 278 278 + let mimetypes = 279 279 + if has_positional then [rest] 280 280 + else 281 281 + String.split_on_char '&' rest 282 282 + |> List.filter_map (fun pair -> 283 283 + match String.split_on_char '=' pair with 284 284 + | [k; v] when k = "accept" -> 285 285 + Some v 286 286 + | _ -> 287 287 + None ) 288 288 + in 289 289 + Blob (if mimetypes = [] then ["*/*"] else mimetypes) 118 290 else Unknown scope 119 291 292 292 + (* parse repo scope string without converting app.bsky/chat.bsky to Bluesky/Chat *) 293 293 + let parse_repo_scope_raw scope = 294 294 + if 295 295 + String.starts_with ~prefix:"repo:" scope 296 296 + || String.starts_with ~prefix:"repo?" scope 297 297 + then 298 298 + let has_positional = String.starts_with ~prefix:"repo:" scope in 299 299 + let rest = String.sub scope 5 (String.length scope - 5) in 300 300 + let parts = String.split_on_char '?' rest in 301 301 + let positional_coll = 302 302 + if has_positional then 303 303 + match parts with coll :: _ when coll <> "" -> Some coll | _ -> None 304 304 + else None 305 305 + in 306 306 + let query_str = 307 307 + if has_positional then 308 308 + if List.length parts > 1 then Some (List.nth parts 1) else None 309 309 + else if rest <> "" then Some rest 310 310 + else None 311 311 + in 312 312 + let parse_query_params qs = 313 313 + String.split_on_char '&' qs 314 314 + |> List.filter_map (fun pair -> 315 315 + match String.split_on_char '=' pair with 316 316 + | [k; v] -> 317 317 + Some (k, v) 318 318 + | _ -> 319 319 + None ) 320 320 + in 321 321 + let params = 322 322 + Option.map parse_query_params query_str |> Option.value ~default:[] 323 323 + in 324 324 + let collection = 325 325 + match positional_coll with 326 326 + | Some c -> 327 327 + [c] 328 328 + | None -> ( 329 329 + List.filter_map 330 330 + (fun (k, v) -> if k = "collection" then Some v else None) 331 331 + params 332 332 + |> function [] -> ["*"] | cols -> cols ) 333 333 + in 334 334 + let actions = 335 335 + let action_strs = 336 336 + List.filter_map 337 337 + (fun (k, v) -> if k = "action" then Some v else None) 338 338 + params 339 339 + |> List.concat_map (String.split_on_char ',') 340 340 + in 341 341 + if action_strs = [] then [Create; Update; Delete] 342 342 + else 343 343 + List.filter_map 344 344 + (fun a -> 345 345 + match a with 346 346 + | "create" -> 347 347 + Some Create 348 348 + | "update" -> 349 349 + Some Update 350 350 + | "delete" -> 351 351 + Some Delete 352 352 + | _ -> 353 353 + None ) 354 354 + action_strs 355 355 + |> function [] -> [Create; Update; Delete] | l -> l 356 356 + in 357 357 + Some {collections= collection; actions} 358 358 + else None 359 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 427 + | PermissionSet _ -> 428 428 + () 187 429 | Unknown s -> 188 430 unknowns := s :: !unknowns ) 189 431 scopes ; ··· 196 438 , !has_chat 197 439 , !unknowns ) 198 440 199 199 - let[@react.component] make ~scopes () = 441 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 445 + let ps_displays = 446 446 + List.map 447 447 + (fun (ps : permission_set_display) -> 448 448 + PermissionSet 449 449 + { nsid= ps.nsid 450 450 + ; title= ps.title 451 451 + ; detail= ps.detail 452 452 + ; expanded_scopes= ps.expanded_scopes } ) 453 453 + permission_sets 454 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 282 - ( if List.length repos > 0 && not has_bluesky then 534 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 485 - ( if List.length blobs > 0 && not has_bluesky then 737 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 778 + (* permission sets *) 779 779 + ( List.map 780 780 + (fun ps -> 781 781 + match ps with 782 782 + | PermissionSet {nsid; title; detail; expanded_scopes} -> 783 783 + let repos = 784 784 + List.filter_map parse_repo_scope_raw expanded_scopes 785 785 + in 786 786 + let coll_actions_map = build_collection_actions_map repos in 787 787 + let coll_actions_list = 788 788 + StringMap.bindings coll_actions_map 789 789 + |> List.sort (fun (a, _) (b, _) -> String.compare a b) 790 790 + in 791 791 + <div key=nsid className="flex items-start gap-3 p-3 rounded-lg"> 792 792 + <div 793 793 + className="flex-shrink-0 w-8 h-8 flex items-center \ 794 794 + justify-center rounded-full bg-mist-20/50 \ 795 795 + text-mist-80"> 796 796 + <BoxesIcon className="w-4 h-4" /> 797 797 + </div> 798 798 + <div className="flex-1 min-w-0"> 799 799 + <div className="font-serif text-mana-100"> 800 800 + (string (Option.value title ~default:nsid)) 801 801 + </div> 802 802 + ( match detail with 803 803 + | Some d -> 804 804 + <div className="text-sm text-mist-100">(string d)</div> 805 805 + | None -> 806 806 + null ) 807 807 + ( if List.length coll_actions_list > 0 then 808 808 + <table className="w-full mt-2 text-xs"> 809 809 + <thead> 810 810 + <tr className="text-mist-80"> 811 811 + <th className="text-left font-normal pb-1"> 812 812 + (string "Collection") 813 813 + </th> 814 814 + <th className="text-center font-normal pb-1 w-16"> 815 815 + (string "Create") 816 816 + </th> 817 817 + <th className="text-center font-normal pb-1 w-16"> 818 818 + (string "Update") 819 819 + </th> 820 820 + <th className="text-center font-normal pb-1 w-16"> 821 821 + (string "Delete") 822 822 + </th> 823 823 + </tr> 824 824 + </thead> 825 825 + <tbody> 826 826 + ( coll_actions_list 827 827 + |> List.map (fun (coll, actions) -> 828 828 + <tr key=coll className="text-mist-100"> 829 829 + <td className="py-0.5"> 830 830 + <span className="font-medium"> 831 831 + (string 832 832 + ( if coll = "*" then "Any collection" 833 833 + else coll ) ) 834 834 + </span> 835 835 + </td> 836 836 + <td className="text-center"> 837 837 + ( if actions.create then 838 838 + <span className="text-mana-100"> 839 839 + (string {js|✓|js}) 840 840 + </span> 841 841 + else null ) 842 842 + </td> 843 843 + <td className="text-center"> 844 844 + ( if actions.update then 845 845 + <span className="text-mana-100"> 846 846 + (string {js|✓|js}) 847 847 + </span> 848 848 + else null ) 849 849 + </td> 850 850 + <td className="text-center"> 851 851 + ( if actions.delete then 852 852 + <span className="text-mana-100"> 853 853 + (string {js|✓|js}) 854 854 + </span> 855 855 + else null ) 856 856 + </td> 857 857 + </tr> ) 858 858 + |> Array.of_list |> array ) 859 859 + </tbody> 860 860 + </table> 861 861 + else null ) 862 862 + </div> 863 863 + </div> 864 864 + | _ -> 865 865 + null ) 866 866 + ps_displays 867 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 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 568 - <form className="w-full h-auto max-w-lg px-4 sm:px-0 my-auto"> 911 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 586 - <ScopesTable scopes /> 929 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

··· 62 62 "Yojson.Safe.t" 63 63 | Query _ | Procedure _ | Subscription _ | Record _ -> 64 64 "unit (* primary type *)" 65 65 + | PermissionSet _ -> 66 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 703 + (* generate permission set module *) 704 704 + let gen_permission_set_module nsid out name (_spec : permission_set_spec) = 705 705 + let type_name = Naming.type_name name in 706 706 + (* generate permission type *) 707 707 + emitln out (Printf.sprintf "(** %s *)" nsid) ; 708 708 + emitln out "type permission =" ; 709 709 + emitln out " { resource: string" ; 710 710 + emitln out " ; lxm: string list option [@default None]" ; 711 711 + emitln out " ; aud: string option [@default None]" ; 712 712 + emitln out 713 713 + " ; inherit_aud: bool option [@key \"inheritAud\"] [@default None]" ; 714 714 + emitln out " ; collection: string list option [@default None]" ; 715 715 + emitln out " ; action: string list option [@default None]" ; 716 716 + emitln out " ; accept: string list option [@default None] }" ; 717 717 + emitln out "[@@deriving yojson {strict= false}]" ; 718 718 + emit_newline out ; 719 719 + (* generate main type *) 720 720 + emitln out (Printf.sprintf "type %s =" type_name) ; 721 721 + emitln out " { title: string option [@default None]" ; 722 722 + emitln out " ; detail: string option [@default None]" ; 723 723 + emitln out " ; permissions: permission list }" ; 724 724 + emitln out "[@@deriving yojson {strict= false}]" ; 725 725 + emit_newline out 726 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 772 + | PermissionSet spec -> 773 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 1130 + | PermissionSet _ -> 1131 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 2307 + | PermissionSet _ -> 2308 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

··· 88 88 ; record: object_spec 89 89 ; description: string option } 90 90 91 91 + and lex_permission = 92 92 + { resource: string 93 93 + ; extra: (string * Yojson.Safe.t) list } 94 94 + 95 95 + and permission_set_spec = 96 96 + { title: string option 97 97 + ; title_lang: (string * string) list option 98 98 + ; detail: string option 99 99 + ; detail_lang: (string * string) list option 100 100 + ; permissions: lex_permission list 101 101 + ; description: string option } 102 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 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

··· 151 151 Subscription (parse_subscription_spec json) 152 152 | "record" -> 153 153 Record (parse_record_spec json) 154 154 + | "permission-set" -> 155 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 322 + ; description= get_string_opt "description" json } 323 323 + 324 324 + and parse_permission json : lex_permission = 325 325 + let resource = get_string "resource" json in 326 326 + let extra = 327 327 + match json with 328 328 + | `Assoc pairs -> 329 329 + List.filter (fun (k, _) -> k <> "resource") pairs 330 330 + | _ -> 331 331 + [] 332 332 + in 333 333 + {resource; extra} 334 334 + 335 335 + and parse_lang_map key json : (string * string) list option = 336 336 + match json with 337 337 + | `Assoc pairs -> 338 338 + let prefix = key ^ ":" in 339 339 + let lang_pairs = 340 340 + List.filter_map 341 341 + (fun (k, v) -> 342 342 + if String.starts_with ~prefix k then 343 343 + let lang = 344 344 + String.sub k (String.length prefix) 345 345 + (String.length k - String.length prefix) 346 346 + in 347 347 + match v with `String s -> Some (lang, s) | _ -> None 348 348 + else None ) 349 349 + pairs 350 350 + in 351 351 + if lang_pairs = [] then None else Some lang_pairs 352 352 + | _ -> 353 353 + None 354 354 + 355 355 + and parse_permission_set_spec json : permission_set_spec = 356 356 + let permissions = 357 357 + match get_list_opt "permissions" json with 358 358 + | Some l -> 359 359 + List.map 360 360 + (function 361 361 + | `Assoc _ as j -> 362 362 + parse_permission j 363 363 + | _ -> 364 364 + failwith "invalid permission" ) 365 365 + l 366 366 + | None -> 367 367 + [] 368 368 + in 369 369 + { title= get_string_opt "title" json 370 370 + ; title_lang= parse_lang_map "title" json 371 371 + ; detail= get_string_opt "detail" json 372 372 + ; detail_lang= parse_lang_map "detail" json 373 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

··· 427 427 (contains code "type status = string") ; 428 428 check bool "contains status_of_yojson" true (contains code "status_of_yojson") 429 429 430 430 + (* test generating permission-set module *) 431 431 + let test_gen_permission_set () = 432 432 + let perm1 : Lexicon_types.lex_permission = 433 433 + { resource= "rpc" 434 434 + ; extra= 435 435 + [("lxm", `List [`String "com.example.foo"]); ("inheritAud", `Bool true)] 436 436 + } 437 437 + in 438 438 + let perm2 : Lexicon_types.lex_permission = 439 439 + { resource= "repo" 440 440 + ; extra= [("collection", `List [`String "com.example.data"])] } 441 441 + in 442 442 + let ps_spec : Lexicon_types.permission_set_spec = 443 443 + { title= Some "Test Permissions" 444 444 + ; title_lang= Some [("de", "Test Berechtigungen")] 445 445 + ; detail= Some "Access to test features" 446 446 + ; detail_lang= None 447 447 + ; permissions= [perm1; perm2] 448 448 + ; description= None } 449 449 + in 450 450 + let doc = 451 451 + make_lexicon "com.example.perms" 452 452 + [make_def "main" (Lexicon_types.PermissionSet ps_spec)] 453 453 + in 454 454 + let code = Codegen.gen_lexicon_module doc in 455 455 + check bool "contains type permission" true (contains code "type permission =") ; 456 456 + check bool "contains resource field" true (contains code "resource: string") ; 457 457 + check bool "contains lxm field" true (contains code "lxm: string list option") ; 458 458 + check bool "contains inherit_aud field" true 459 459 + (contains code "inherit_aud: bool option") ; 460 460 + check bool "contains type main" true (contains code "type main =") ; 461 461 + check bool "contains title field" true (contains code "title: string option") ; 462 462 + check bool "contains permissions field" true 463 463 + (contains code "permissions: permission list") ; 464 464 + check bool "contains deriving" true (contains code "[@@deriving yojson") 465 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 553 + let permission_set_tests = 554 554 + [("generate permission-set", `Quick, test_gen_permission_set)] 555 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 524 - ; ("strings", string_tests) ] 563 563 + ; ("strings", string_tests) 564 564 + ; ("permission-set", permission_set_tests) ]

+53 -1

hermes-cli/test/test_parser.ml

··· 280 280 | Error e -> 281 281 fail ("parse failed: " ^ e) 282 282 283 283 + (* parsing permission-set type *) 284 284 + let test_parse_permission_set () = 285 285 + let json = 286 286 + {|{ 287 287 + "lexicon": 1, 288 288 + "id": "com.example.auth", 289 289 + "defs": { 290 290 + "main": { 291 291 + "type": "permission-set", 292 292 + "title": "Example Auth", 293 293 + "title:de": "Beispiel Auth", 294 294 + "detail": "Access to authentication features", 295 295 + "permissions": [ 296 296 + { 297 297 + "resource": "rpc", 298 298 + "lxm": ["com.example.auth.login", "com.example.auth.logout"], 299 299 + "inheritAud": true 300 300 + }, 301 301 + { 302 302 + "resource": "repo", 303 303 + "collection": ["com.example.auth.session"], 304 304 + "action": ["create", "delete"] 305 305 + } 306 306 + ] 307 307 + } 308 308 + } 309 309 + }|} 310 310 + in 311 311 + match Parser.parse_string json with 312 312 + | Ok doc -> ( 313 313 + check test_string "id matches" "com.example.auth" doc.id ; 314 314 + check int "one definition" 1 (List.length doc.defs) ; 315 315 + let def = List.hd doc.defs in 316 316 + match def.type_def with 317 317 + | Lexicon_types.PermissionSet spec -> 318 318 + check (option test_string) "title" (Some "Example Auth") spec.title ; 319 319 + check (option test_string) "detail" 320 320 + (Some "Access to authentication features") spec.detail ; 321 321 + check int "two permissions" 2 (List.length spec.permissions) ; 322 322 + let perm1 = List.hd spec.permissions in 323 323 + check test_string "first resource" "rpc" perm1.resource ; 324 324 + (* check extra fields are captured *) 325 325 + check bool "has lxm in extra" true (List.mem_assoc "lxm" perm1.extra) 326 326 + | _ -> 327 327 + fail "expected permission-set type" ) 328 328 + | Error e -> 329 329 + fail ("parse failed: " ^ e) 330 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 369 + let permission_set_tests = 370 370 + [("parse permission-set", `Quick, test_parse_permission_set)] 371 371 + 321 372 let () = 322 373 run "Parser" 323 374 [ ("objects", object_tests) 324 375 ; ("complex_types", complex_type_tests) 325 325 - ; ("errors", error_tests) ] 376 376 + ; ("errors", error_tests) 377 377 + ; ("permission-set", permission_set_tests) ]

+37 -1

pegasus/lib/api/oauth_/authorize.ml

··· 79 79 | None -> 80 80 login_redirect 81 81 | Some _ -> 82 82 - let scopes = String.split_on_char ' ' req.scope in 82 82 + (* parse and resolve permission sets for display *) 83 83 + let raw_scopes = String.split_on_char ' ' req.scope in 84 84 + let parsed_scopes = 85 85 + Oauth.Scopes.parse_scopes req.scope 86 86 + in 87 87 + let%lwt permission_sets = 88 88 + Lwt_list.filter_map_p 89 89 + (fun scope -> 90 90 + match scope with 91 91 + | Oauth.Scopes.Include inc -> ( 92 92 + match%lwt 93 93 + Lexicon_resolver.resolve inc.nsid 94 94 + with 95 95 + | Error _ -> 96 96 + Lwt.return_none 97 97 + | Ok ps -> 98 98 + let expanded = 99 99 + Oauth.Scopes.expand_include_scope inc ps 100 100 + in 101 101 + Lwt.return_some 102 102 + { Frontend.OauthAuthorizePage.nsid= 103 103 + inc.nsid 104 104 + ; title= ps.title 105 105 + ; detail= ps.detail 106 106 + ; expanded_scopes= expanded } ) 107 107 + | _ -> 108 108 + Lwt.return_none ) 109 109 + parsed_scopes 110 110 + in 111 111 + (* separate include scopes from regular scopes for display *) 112 112 + let scopes = 113 113 + List.filter 114 114 + (fun s -> 115 115 + not (String.starts_with ~prefix:"include:" s) ) 116 116 + raw_scopes 117 117 + in 83 118 let csrf_token = Dream.csrf_token ctx.req in 84 119 let client_id_uri = 85 120 Option.map Uri.of_string metadata.client_id ··· 110 145 ; logged_in_users 111 146 ; current_user 112 147 ; scopes 148 148 + ; permission_sets 113 149 ; code 114 150 ; request_uri 115 151 ; csrf_token } ) ) ) )

+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 89 + (* expand scopes before creating token *) 90 90 + let%lwt expanded_scopes = 91 91 + let parsed = Scopes.parse_scopes orig_req.scope in 92 92 + let%lwt expanded = Scopes.expand_scopes parsed in 93 93 + Lwt.return (Scopes.scopes_to_string expanded) 94 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 95 - ; ("scope", `String orig_req.scope) 101 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 120 - ; scope= orig_req.scope 126 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 138 - ; ("scope", `String orig_req.scope) 144 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

··· 10 10 failwith "non-refresh auth" 11 11 in 12 12 let%lwt () = Data_store.revoke_token ~did ~jti db in 13 13 - let%lwt 14 14 - { handle 15 15 - ; did 16 16 - ; email 17 17 - ; email_auth_factor 18 18 - ; email_confirmed 19 19 - ; active 20 20 - ; status 21 21 - ; _ } = 22 22 - Auth.get_session_info did db 23 23 - in 13 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 27 - { access_jwt 28 28 - ; refresh_jwt 29 29 - ; handle 30 30 - ; did 31 31 - ; email 32 32 - ; email_auth_factor 33 33 - ; email_confirmed 34 34 - ; active 35 35 - ; status 36 36 - ; did_doc= None } ) 17 17 + {access_jwt; refresh_jwt; handle; did; active; status; did_doc= None} )

+118

pegasus/lib/lexicon_resolver.ml

··· 1 1 + type permission = 2 2 + { resource: string 3 3 + ; lxm: string list option [@default None] 4 4 + ; aud: string option [@default None] 5 5 + ; inherit_aud: bool option [@key "inheritAud"] [@default None] 6 6 + ; collection: string list option [@default None] 7 7 + ; action: string list option [@default None] 8 8 + ; accept: string list option [@default None] } 9 9 + [@@deriving yojson {strict= false}] 10 10 + 11 11 + type permission_set = 12 12 + { title: string option [@default None] 13 13 + ; title_lang: (string * string) list option [@default None] 14 14 + ; detail: string option [@default None] 15 15 + ; detail_lang: (string * string) list option [@default None] 16 16 + ; permissions: permission list } 17 17 + [@@deriving yojson {strict= false}] 18 18 + 19 19 + type lexicon_value = 20 20 + { type_: string [@key "$type"] 21 21 + ; title: string option [@default None] 22 22 + ; detail: string option [@default None] 23 23 + ; permissions: permission list option [@default None] } 24 24 + [@@deriving yojson {strict= false}] 25 25 + 26 26 + let cache : permission_set Ttl_cache.String_cache.t = 27 27 + Ttl_cache.String_cache.create (3 * Util.hour) () 28 28 + 29 29 + (* reuse dns client from id_resolver *) 30 30 + let dns_client = Id_resolver.Handle.dns_client 31 31 + 32 32 + (* resolve did authority for nsid *) 33 33 + let resolve_did_authority nsid = 34 34 + let authority = Util.nsid_authority nsid in 35 35 + try%lwt 36 36 + let%lwt result = 37 37 + Dns_client_lwt.getaddrinfo dns_client Dns.Rr_map.Txt 38 38 + (Domain_name.of_string_exn ("_lexicon." ^ authority)) 39 39 + in 40 40 + match result with 41 41 + | Ok (_, t) -> ( 42 42 + let txt = Dns.Rr_map.Txt_set.choose t in 43 43 + match String.split_on_char '=' txt with 44 44 + | ["did"; did] 45 45 + when String.starts_with ~prefix:"did:plc:" did 46 46 + || String.starts_with ~prefix:"did:web:" did -> 47 47 + Lwt.return_ok (String.trim did) 48 48 + | _ -> 49 49 + Lwt.return_error "invalid did in dns record" ) 50 50 + | Error (`Msg e) -> 51 51 + Lwt.return_error e 52 52 + with exn -> Lwt.return_error (Printexc.to_string exn) 53 53 + 54 54 + (* fetch lexicon document from authority's repo *) 55 55 + let fetch_lexicon ~did ~nsid = 56 56 + try%lwt 57 57 + match%lwt Id_resolver.Did.resolve did with 58 58 + | Error e -> 59 59 + Lwt.return_error ("failed to resolve DID: " ^ e) 60 60 + | Ok doc -> ( 61 61 + match Id_resolver.Did.Document.get_service doc "#atproto_pds" with 62 62 + | None -> 63 63 + Lwt.return_error "no PDS service in DID document" 64 64 + | Some pds -> ( 65 65 + let client = Hermes.make_client ~service:pds () in 66 66 + try%lwt 67 67 + let%lwt record = 68 68 + Lexicons.([%xrpc get "com.atproto.repo.getRecord"]) 69 69 + ~repo:did ~collection:"com.atproto.lexicon.schema" ~rkey:nsid 70 70 + client 71 71 + in 72 72 + Lwt.return_ok record.value 73 73 + with _ -> Lwt.return_error ("failed to fetch lexicon record " ^ nsid) 74 74 + ) ) 75 75 + with exn -> Lwt.return_error (Printexc.to_string exn) 76 76 + 77 77 + (* parse lexicon record into permission_set *) 78 78 + let parse_permission_set record = 79 79 + match lexicon_value_of_yojson record with 80 80 + | Error e -> 81 81 + Error ("failed to parse lexicon record: " ^ e) 82 82 + | Ok record -> ( 83 83 + if record.type_ <> "permission-set" then 84 84 + Error ("not a permission-set lexicon: " ^ record.type_) 85 85 + else 86 86 + match record.permissions with 87 87 + | None -> 88 88 + Error "permission-set has no permissions" 89 89 + | Some permissions -> 90 90 + Ok 91 91 + { title= record.title 92 92 + ; title_lang= None (* skip localized titles for now *) 93 93 + ; detail= record.detail 94 94 + ; detail_lang= None (* skip localized details for now *) 95 95 + ; permissions } ) 96 96 + 97 97 + (* resolve and parse permission set from nsid *) 98 98 + let resolve nsid = 99 99 + match Ttl_cache.String_cache.get cache nsid with 100 100 + | Some cached -> 101 101 + Lwt.return_ok cached 102 102 + | None -> ( 103 103 + match%lwt resolve_did_authority nsid with 104 104 + | Error e -> 105 105 + Lwt.return_error ("DNS resolution failed: " ^ e) 106 106 + | Ok did -> ( 107 107 + match%lwt fetch_lexicon ~did ~nsid with 108 108 + | Error e -> 109 109 + Lwt.return_error ("lexicon fetch failed: " ^ e) 110 110 + | Ok json -> ( 111 111 + match parse_permission_set json with 112 112 + | Error e -> 113 113 + Lwt.return_error e 114 114 + | Ok ps -> 115 115 + Ttl_cache.String_cache.set cache nsid ps ; 116 116 + Lwt.return_ok ps ) ) ) 117 117 + 118 118 + let clear_cache nsid = Ttl_cache.String_cache.remove cache nsid

+252 -45

pegasus/lib/oauth/scopes.ml

··· 1 1 - type account_attr = Email | Repo | Status 1 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 39 + type include_scope = {nsid: string; aud: string option} 40 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 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 70 + (* check if permission_nsid is under include_nsid's authority *) 71 71 + let is_parent_authority_of ~include_nsid ~permission_nsid = 72 72 + let include_authority = Util.nsid_authority include_nsid in 73 73 + let permission_authority = Util.nsid_authority permission_nsid in 74 74 + String.equal include_authority permission_authority 75 75 + || String.starts_with ~prefix:(include_authority ^ ".") permission_authority 76 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 127 - | "status" -> 128 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 185 - let collection_strs = 186 186 - match positional with 187 187 - | Some p -> 188 188 - [p] 189 189 - | None -> 190 190 - get_all_params "collection" params 191 191 - in 192 192 - if collection_strs = [] then None 193 193 + (* duplicate positional and query parameters not allowed *) 194 194 + let has_collection_param = get_all_params "collection" params <> [] in 195 195 + if positional <> None && has_collection_param then None 193 196 else 194 194 - let collections = List.filter_map parse_repo_collection collection_strs in 195 195 - if collections = [] then None 197 197 + let collection_strs = 198 198 + match positional with 199 199 + | Some p -> 200 200 + [p] 201 201 + | None -> 202 202 + get_all_params "collection" params 203 203 + in 204 204 + if collection_strs = [] then None 196 205 else 197 197 - let action_strs = get_all_params "action" params in 198 198 - let actions = 199 199 - if action_strs = [] then all_repo_actions 200 200 - else List.filter_map parse_repo_action action_strs 201 201 - in 202 202 - if actions = [] then None else Some {collections; actions} 206 206 + let collections = List.filter_map parse_repo_collection collection_strs in 207 207 + if collections = [] then None 208 208 + else 209 209 + let action_strs = get_all_params "action" params in 210 210 + let actions = 211 211 + if action_strs = [] then all_repo_actions 212 212 + else List.filter_map parse_repo_action action_strs 213 213 + in 214 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 227 - let lxm_strs = 228 228 - match positional with Some p -> [p] | None -> get_all_params "lxm" params 229 229 - in 230 230 - if lxm_strs = [] then None 239 239 + (* duplicate positional and query parameters not allowed *) 240 240 + let has_lxm_param = get_all_params "lxm" params <> [] in 241 241 + if positional <> None && has_lxm_param then None 231 242 else 232 232 - let lxms = List.filter_map parse_rpc_lxm lxm_strs in 233 233 - if lxms = [] then None 243 243 + let lxm_strs = 244 244 + match positional with 245 245 + | Some p -> 246 246 + [p] 247 247 + | None -> 248 248 + get_all_params "lxm" params 249 249 + in 250 250 + if lxm_strs = [] then None 234 251 else 235 235 - match get_single_param "aud" params with 236 236 - | None -> 237 237 - None (* aud is required *) 238 238 - | Some aud_str -> ( 239 239 - match parse_rpc_aud aud_str with 252 252 + let lxms = List.filter_map parse_rpc_lxm lxm_strs in 253 253 + if lxms = [] then None 254 254 + else 255 255 + match get_single_param "aud" params with 240 256 | None -> 241 241 - None 242 242 - | Some aud -> 243 243 - (* rpc:*?aud=* is forbidden *) 244 244 - if aud = AnyAud && List.mem AnyLxm lxms then None 245 245 - else Some {lxm= lxms; aud} ) 257 257 + None (* aud is required *) 258 258 + | Some aud_str -> ( 259 259 + match parse_rpc_aud aud_str with 260 260 + | None -> 261 261 + None 262 262 + | Some aud -> 263 263 + (* rpc:*?aud=* is forbidden *) 264 264 + if aud = AnyAud && List.mem AnyLxm lxms then None 265 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 263 - let accept_strs = 264 264 - match positional with 265 265 - | Some p -> 266 266 - [p] 267 267 - | None -> 268 268 - get_all_params "accept" params 269 269 - in 270 270 - if accept_strs = [] then None 283 283 + (* duplicate positional and query parameters not allowed *) 284 284 + let has_accept_param = get_all_params "accept" params <> [] in 285 285 + if positional <> None && has_accept_param then None 271 286 else 272 272 - let accepts = List.filter_map parse_accept_pattern accept_strs in 273 273 - if accepts = [] then None else Some {accept= accepts} 287 287 + let accept_strs = 288 288 + match positional with 289 289 + | Some p -> 290 290 + [p] 291 291 + | None -> 292 292 + get_all_params "accept" params 293 293 + in 294 294 + if accept_strs = [] then None 295 295 + else 296 296 + let accepts = List.filter_map parse_accept_pattern accept_strs in 297 297 + if accepts = [] then None else Some {accept= accepts} 298 298 + 299 299 + let parse_include_scope positional params = 300 300 + match positional with 301 301 + | None -> 302 302 + None 303 303 + | Some nsid -> ( 304 304 + if not (is_valid_nsid nsid) then None 305 305 + else 306 306 + let aud = get_single_param "aud" params in 307 307 + (* validate aud if present *) 308 308 + match aud with 309 309 + | Some a when not (is_valid_atproto_audience a) -> 310 310 + None 311 311 + | _ -> 312 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 347 + | "include" -> 348 348 + Option.map 349 349 + (fun p -> Include p) 350 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 503 + 504 504 + (* convert a permission from permission set to scope string *) 505 505 + let permission_to_scope ~include_aud (perm : Lexicon_resolver.permission) = 506 506 + match perm.resource with 507 507 + | "rpc" -> ( 508 508 + match perm.lxm with 509 509 + | None | Some [] -> 510 510 + None 511 511 + | Some lxms -> ( 512 512 + let aud = 513 513 + match perm.aud with 514 514 + | Some a -> 515 515 + Some a 516 516 + | None -> 517 517 + if Option.value perm.inherit_aud ~default:false then include_aud 518 518 + else None 519 519 + in 520 520 + match aud with 521 521 + | None -> 522 522 + None (* rpc requires aud *) 523 523 + | Some a -> 524 524 + Some 525 525 + (List.map 526 526 + (fun lxm -> 527 527 + Printf.sprintf "rpc:%s?aud=%s" lxm (Uri.pct_encode a) ) 528 528 + lxms ) ) ) 529 529 + | "repo" -> ( 530 530 + match perm.collection with 531 531 + | None | Some [] -> 532 532 + None 533 533 + | Some collections -> 534 534 + let actions = 535 535 + Option.value perm.action ~default:["create"; "update"; "delete"] 536 536 + in 537 537 + let action_str = 538 538 + let action_set = List.sort String.compare actions in 539 539 + let default_set = ["create"; "delete"; "update"] in 540 540 + if action_set = default_set then "" 541 541 + else "?action=" ^ String.concat "," actions 542 542 + in 543 543 + Some 544 544 + (List.map 545 545 + (fun coll -> Printf.sprintf "repo:%s%s" coll action_str) 546 546 + collections ) ) 547 547 + | "blob" -> ( 548 548 + match perm.accept with 549 549 + | None | Some [] -> 550 550 + None 551 551 + | Some accepts -> 552 552 + Some (List.map (fun accept -> Printf.sprintf "blob:%s" accept) accepts) 553 553 + ) 554 554 + | "account" | "identity" -> 555 555 + (* account and identity permissions can't be granted via permission sets *) 556 556 + None 557 557 + | _ -> 558 558 + None 559 559 + 560 560 + (* expand include scope to list of granular scopes, 561 561 + validating authority for each permission nsid & applying inheritAud *) 562 562 + let expand_include_scope (inc : include_scope) 563 563 + (ps : Lexicon_resolver.permission_set) = 564 564 + let allowed_resources = ["rpc"; "repo"] in 565 565 + ps.permissions 566 566 + |> List.filter (fun (p : Lexicon_resolver.permission) -> 567 567 + List.mem p.resource allowed_resources ) 568 568 + |> List.filter_map (fun (p : Lexicon_resolver.permission) -> 569 569 + let nsids_to_check = 570 570 + match p.resource with 571 571 + | "rpc" -> 572 572 + Option.value p.lxm ~default:[] 573 573 + | "repo" -> 574 574 + (* filter out wildcards from collection validation *) 575 575 + Option.value p.collection ~default:[] 576 576 + |> List.filter (fun c -> c <> "*" && is_valid_nsid c) 577 577 + | _ -> 578 578 + [] 579 579 + in 580 580 + let all_valid = 581 581 + List.for_all 582 582 + (fun nsid -> 583 583 + is_parent_authority_of ~include_nsid:inc.nsid ~permission_nsid:nsid ) 584 584 + nsids_to_check 585 585 + in 586 586 + if all_valid then permission_to_scope ~include_aud:inc.aud p else None ) 587 587 + |> List.flatten 588 588 + 589 589 + (* expand all scopes, resolving includes, to expanded scope string *) 590 590 + let expand_scopes (scopes : scope list) : string list Lwt.t = 591 591 + let%lwt expanded = 592 592 + Lwt_list.map_p 593 593 + (fun scope -> 594 594 + match scope with 595 595 + | Include inc -> ( 596 596 + match%lwt Lexicon_resolver.resolve inc.nsid with 597 597 + | Error e -> 598 598 + Logs.warn (fun l -> 599 599 + l "failed to resolve permission set %s: %s" inc.nsid e ) ; 600 600 + Lwt.return [] 601 601 + | Ok ps -> 602 602 + Lwt.return (expand_include_scope inc ps) ) 603 603 + | Static Atproto -> 604 604 + Lwt.return ["atproto"] 605 605 + | Static TransitionEmail -> 606 606 + Lwt.return ["transition:email"] 607 607 + | Static TransitionGeneric -> 608 608 + Lwt.return ["transition:generic"] 609 609 + | Static TransitionChatBsky -> 610 610 + Lwt.return ["transition:chat.bsky"] 611 611 + | Account perm -> 612 612 + let attr_str = 613 613 + match perm.attr with Email -> "email" | Repo -> "repo" 614 614 + in 615 615 + let actions_str = 616 616 + if List.mem Manage perm.actions then "?action=manage" else "" 617 617 + in 618 618 + Lwt.return [Printf.sprintf "account:%s%s" attr_str actions_str] 619 619 + | Identity perm -> 620 620 + let attr_str = 621 621 + match perm.attr with Handle -> "handle" | Any -> "*" 622 622 + in 623 623 + Lwt.return [Printf.sprintf "identity:%s" attr_str] 624 624 + | Repo perm -> 625 625 + let colls = 626 626 + List.map 627 627 + (function All -> "*" | Collection c -> c) 628 628 + perm.collections 629 629 + in 630 630 + let actions = List.map show_repo_action perm.actions in 631 631 + let action_str = 632 632 + if actions = ["create"; "update"; "delete"] then "" 633 633 + else "?action=" ^ String.concat "," actions 634 634 + in 635 635 + Lwt.return 636 636 + (List.map 637 637 + (fun c -> Printf.sprintf "repo:%s%s" c action_str) 638 638 + colls ) 639 639 + | Rpc perm -> 640 640 + let lxms = 641 641 + List.map (function AnyLxm -> "*" | Lxm l -> l) perm.lxm 642 642 + in 643 643 + let aud_str = match perm.aud with AnyAud -> "*" | Aud a -> a in 644 644 + Lwt.return 645 645 + (List.map 646 646 + (fun l -> 647 647 + Printf.sprintf "rpc:%s?aud=%s" l (Uri.pct_encode aud_str) ) 648 648 + lxms ) 649 649 + | Blob perm -> 650 650 + let accepts = 651 651 + List.map 652 652 + (function 653 653 + | AnyMime -> 654 654 + "*/*" 655 655 + | TypeWildcard t -> 656 656 + t ^ "/*" 657 657 + | ExactMime (t, s) -> 658 658 + t ^ "/" ^ s ) 659 659 + perm.accept 660 660 + in 661 661 + Lwt.return (List.map (fun a -> Printf.sprintf "blob:%s" a) accepts) ) 662 662 + scopes 663 663 + in 664 664 + Lwt.return (List.flatten expanded |> List.sort_uniq String.compare) 665 665 + 666 666 + let scopes_to_string scopes = String.concat " " scopes

+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 554 + let nsid_authority nsid = 555 555 + match String.rindex_opt nsid '.' with 556 556 + | None -> 557 557 + nsid 558 558 + | Some idx -> 559 559 + String.sub nsid 0 idx 560 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

··· 1 1 (tests 2 2 - (names test_sequencer) 2 2 + (names test_sequencer test_scopes) 3 3 (package pegasus) 4 4 - (libraries ipld pegasus lwt_ppx alcotest) 4 4 + (libraries ipld pegasus lwt lwt.unix lwt_ppx alcotest str) 5 5 (preprocess 6 6 (pps lwt_ppx)))

+177

pegasus/test/test_scopes.ml

··· 1 1 + open Alcotest 2 2 + open Pegasus.Oauth.Scopes 3 3 + 4 4 + let test_string = testable Fmt.string String.equal 5 5 + 6 6 + let test_nsid_authority () = 7 7 + check test_string "three segments" "com.example" 8 8 + (Pegasus.Util.nsid_authority "com.example.foo") ; 9 9 + check test_string "four segments" "com.example.app" 10 10 + (Pegasus.Util.nsid_authority "com.example.app.auth") ; 11 11 + check test_string "two segments" "com" 12 12 + (Pegasus.Util.nsid_authority "com.example") 13 13 + 14 14 + let test_is_parent_authority () = 15 15 + check bool "same authority" true 16 16 + (is_parent_authority_of ~include_nsid:"com.example.app.auth" 17 17 + ~permission_nsid:"com.example.app.calendar" ) ; 18 18 + check bool "child authority" true 19 19 + (is_parent_authority_of ~include_nsid:"com.example.app.auth" 20 20 + ~permission_nsid:"com.example.app.sub.thing" ) ; 21 21 + check bool "different authority" false 22 22 + (is_parent_authority_of ~include_nsid:"com.example.app.auth" 23 23 + ~permission_nsid:"org.other.thing" ) ; 24 24 + check bool "partial match not ok" false 25 25 + (is_parent_authority_of ~include_nsid:"com.example.app.auth" 26 26 + ~permission_nsid:"com.example.different" ) 27 27 + 28 28 + (* test parse_scope for include scopes *) 29 29 + let test_parse_include_scope () = 30 30 + (* valid include scope with aud *) 31 31 + ( match 32 32 + parse_scope "include:com.example.app.auth?aud=did:web:api.example.com" 33 33 + with 34 34 + | Some (Include {nsid; aud}) -> 35 35 + check test_string "nsid" "com.example.app.auth" nsid ; 36 36 + check (option test_string) "aud" (Some "did:web:api.example.com") aud 37 37 + | _ -> 38 38 + fail "expected Include scope" ) ; 39 39 + (* valid include scope without aud *) 40 40 + ( match parse_scope "include:com.example.app.perms" with 41 41 + | Some (Include {nsid; aud}) -> 42 42 + check test_string "nsid" "com.example.app.perms" nsid ; 43 43 + check (option test_string) "aud" None aud 44 44 + | _ -> 45 45 + fail "expected Include scope" ) ; 46 46 + (* bad nsid *) 47 47 + ( match parse_scope "include:invalid" with 48 48 + | None -> 49 49 + () 50 50 + | Some _ -> 51 51 + fail "expected None for invalid nsid" ) ; 52 52 + (* bad aud *) 53 53 + match parse_scope "include:com.example.foo?aud=notadid" with 54 54 + | None -> 55 55 + () 56 56 + | Some _ -> 57 57 + fail "expected None for invalid aud" 58 58 + 59 59 + let test_permission_to_scope () = 60 60 + let open Pegasus.Lexicon_resolver in 61 61 + (* rpc permission with explicit aud *) 62 62 + let rpc_perm = 63 63 + { resource= "rpc" 64 64 + ; lxm= Some ["com.example.foo"; "com.example.bar"] 65 65 + ; aud= Some "did:web:api.example.com" 66 66 + ; inherit_aud= None 67 67 + ; collection= None 68 68 + ; action= None 69 69 + ; accept= None } 70 70 + in 71 71 + ( match permission_to_scope ~include_aud:None rpc_perm with 72 72 + | Some scopes -> 73 73 + check int "two rpc scopes" 2 (List.length scopes) ; 74 74 + (* check that first scope starts with expected pattern *) 75 75 + check bool "first scope valid" true 76 76 + (String.starts_with ~prefix:"rpc:com.example.foo?aud=" 77 77 + (List.nth scopes 0) ) 78 78 + | None -> 79 79 + fail "expected Some scopes" ) ; 80 80 + (* rpc permission with inheritAud *) 81 81 + let rpc_inherit = 82 82 + { resource= "rpc" 83 83 + ; lxm= Some ["com.example.baz"] 84 84 + ; aud= None 85 85 + ; inherit_aud= Some true 86 86 + ; collection= None 87 87 + ; action= None 88 88 + ; accept= None } 89 89 + in 90 90 + ( match 91 91 + permission_to_scope ~include_aud:(Some "did:plc:inherited") rpc_inherit 92 92 + with 93 93 + | Some scopes -> 94 94 + check int "inherited aud single scope" 1 (List.length scopes) ; 95 95 + check bool "inherited aud scope valid" true 96 96 + (String.starts_with ~prefix:"rpc:com.example.baz?aud=" 97 97 + (List.nth scopes 0) ) 98 98 + | None -> 99 99 + fail "expected scopes with inherited aud" ) ; 100 100 + (* repo permission included *) 101 101 + let repo_perm = 102 102 + { resource= "repo" 103 103 + ; lxm= None 104 104 + ; aud= None 105 105 + ; inherit_aud= None 106 106 + ; collection= Some ["com.example.data"] 107 107 + ; action= Some ["create"; "update"] 108 108 + ; accept= None } 109 109 + in 110 110 + ( match permission_to_scope ~include_aud:None repo_perm with 111 111 + | Some [scope] -> 112 112 + check bool "repo scope" true 113 113 + (String.starts_with ~prefix:"repo:com.example.data" scope) 114 114 + | _ -> 115 115 + fail "expected single repo scope" ) ; 116 116 + (* account permission filtered out *) 117 117 + let account_perm = 118 118 + { resource= "account" 119 119 + ; lxm= None 120 120 + ; aud= None 121 121 + ; inherit_aud= None 122 122 + ; collection= None 123 123 + ; action= None 124 124 + ; accept= None } 125 125 + in 126 126 + match permission_to_scope ~include_aud:None account_perm with 127 127 + | None -> 128 128 + () 129 129 + | Some _ -> 130 130 + fail "account should be filtered" 131 131 + 132 132 + let test_expand_include_scope_authority () = 133 133 + let open Pegasus.Lexicon_resolver in 134 134 + let inc : include_scope = 135 135 + {nsid= "com.example.app.auth"; aud= Some "did:web:api.example.com"} 136 136 + in 137 137 + let ps = 138 138 + { title= Some "Test" 139 139 + ; title_lang= None 140 140 + ; detail= None 141 141 + ; detail_lang= None 142 142 + ; permissions= 143 143 + [ (* valid under com.example.app authority *) 144 144 + { resource= "rpc" 145 145 + ; lxm= Some ["com.example.app.login"] 146 146 + ; aud= None 147 147 + ; inherit_aud= Some true 148 148 + ; collection= None 149 149 + ; action= None 150 150 + ; accept= None } 151 151 + ; (* invalid, different authority *) 152 152 + { resource= "rpc" 153 153 + ; lxm= Some ["org.other.thing"] 154 154 + ; aud= None 155 155 + ; inherit_aud= Some true 156 156 + ; collection= None 157 157 + ; action= None 158 158 + ; accept= None } ] } 159 159 + in 160 160 + let expanded = expand_include_scope inc ps in 161 161 + check int "only valid permission expanded" 1 (List.length expanded) ; 162 162 + (* check that we have at least one scope starting with rpc: *) 163 163 + check bool "has rpc scope" true 164 164 + ( List.length expanded > 0 165 165 + && String.starts_with ~prefix:"rpc:" (List.hd expanded) ) 166 166 + 167 167 + let () = 168 168 + run "scopes" 169 169 + [ ( "authority" 170 170 + , [ ("nsid_authority", `Quick, test_nsid_authority) 171 171 + ; ("is_parent_authority_of", `Quick, test_is_parent_authority) ] ) 172 172 + ; ("include", [("parse_include_scope", `Quick, test_parse_include_scope)]) 173 173 + ; ( "expansion" 174 174 + , [ ("permission_to_scope", `Quick, test_permission_to_scope) 175 175 + ; ( "expand_include_scope_authority" 176 176 + , `Quick 177 177 + , test_expand_include_scope_authority ) ] ) ]