objective categorical abstract machine language personal data server
65
fork

Configure Feed

Select the types of activity you want to include in your feed.

Add OAuth scopes module

futurGH 591348a2 8050d141

+426
+426
pegasus/lib/oauth/scopes.ml
··· 1 + type account_attr = Email | Repo | Status 2 + 3 + type account_action = Read | Manage 4 + 5 + type account_permission = {attr: account_attr; actions: account_action list} 6 + 7 + type identity_attr = Handle | Any 8 + 9 + type identity_permission = {attr: identity_attr} 10 + 11 + type repo_action = Create | Update | Delete 12 + 13 + type repo_collection = All | Collection of string 14 + 15 + type repo_permission = 16 + {collections: repo_collection list; actions: repo_action list} 17 + 18 + type rpc_lxm = AnyLxm | Lxm of string 19 + 20 + type rpc_aud = AnyAud | Aud of string 21 + 22 + type rpc_permission = {lxm: rpc_lxm list; aud: rpc_aud} 23 + 24 + type accept_pattern = 25 + | AnyMime (** */* *) 26 + | TypeWildcard of string (** e.g. image/* *) 27 + | ExactMime of string * string (** e.g. image/png *) 28 + 29 + type blob_permission = {accept: accept_pattern list} 30 + 31 + type static_scope = 32 + | Atproto 33 + | TransitionEmail 34 + | TransitionGeneric 35 + | TransitionChatBsky 36 + 37 + type scope = 38 + | Static of static_scope 39 + | Account of account_permission 40 + | Identity of identity_permission 41 + | Repo of repo_permission 42 + | Rpc of rpc_permission 43 + | Blob of blob_permission 44 + 45 + let is_valid_nsid s = 46 + let segments = String.split_on_char '.' s in 47 + let valid_segment seg = 48 + String.length seg > 0 49 + && String.for_all 50 + (fun c -> 51 + (c >= 'a' && c <= 'z') 52 + || (c >= 'A' && c <= 'Z') 53 + || (c >= '0' && c <= '9') 54 + || c = '-' ) 55 + seg 56 + in 57 + List.length segments >= 3 && List.for_all valid_segment segments 58 + 59 + let parse_params s = 60 + if s = "" then [] 61 + else 62 + String.split_on_char '&' s 63 + |> List.filter_map (fun pair -> 64 + match String.split_on_char '=' pair with 65 + | [k; v] -> 66 + Some (Uri.pct_decode k, Uri.pct_decode v) 67 + | [k] -> 68 + Some (Uri.pct_decode k, "") 69 + | _ -> 70 + None ) 71 + 72 + let get_all_params key params = 73 + List.filter_map (fun (k, v) -> if k = key then Some v else None) params 74 + 75 + let get_single_param key params = 76 + match get_all_params key params with [v] -> Some v | _ -> None 77 + 78 + let parse_scope_syntax s = 79 + let qmark_idx = String.index_opt s '?' in 80 + let colon_idx = String.index_opt s ':' in 81 + let prefix_end = 82 + match (qmark_idx, colon_idx) with 83 + | None, None -> 84 + String.length s 85 + | Some q, None -> 86 + q 87 + | None, Some c -> 88 + c 89 + | Some q, Some c -> 90 + min q c 91 + in 92 + let prefix = String.sub s 0 prefix_end in 93 + let positional = 94 + match colon_idx with 95 + | Some c when c = prefix_end -> 96 + let end_pos = 97 + match qmark_idx with Some q -> q | None -> String.length s 98 + in 99 + if end_pos > c + 1 then 100 + Some (Uri.pct_decode (String.sub s (c + 1) (end_pos - c - 1))) 101 + else None 102 + | _ -> 103 + None 104 + in 105 + let params = 106 + match qmark_idx with 107 + | Some q when q < String.length s - 1 -> 108 + parse_params (String.sub s (q + 1) (String.length s - q - 1)) 109 + | _ -> 110 + [] 111 + in 112 + (prefix, positional, params) 113 + 114 + let parse_account_attr = function 115 + | "email" -> 116 + Some Email 117 + | "repo" -> 118 + Some Repo 119 + | "status" -> 120 + Some Status 121 + | _ -> 122 + None 123 + 124 + let parse_account_action = function 125 + | "read" -> 126 + Some Read 127 + | "manage" -> 128 + Some Manage 129 + | _ -> 130 + None 131 + 132 + let parse_account_permission positional params = 133 + let attr = positional |> Option.map parse_account_attr |> Option.join in 134 + let action_strs = get_all_params "action" params in 135 + let actions = 136 + if action_strs = [] then [Read] 137 + else List.filter_map parse_account_action action_strs 138 + in 139 + match (actions, attr) with 140 + | _action :: _, Some attr -> 141 + Some {attr; actions} 142 + | _ -> 143 + None 144 + 145 + let parse_identity_attr = function 146 + | "handle" -> 147 + Some Handle 148 + | "*" -> 149 + Some Any 150 + | _ -> 151 + None 152 + 153 + let parse_identity_permission positional _params = 154 + positional 155 + |> Option.map parse_identity_attr 156 + |> Option.join 157 + |> Option.map (fun attr -> {attr}) 158 + 159 + let parse_repo_action = function 160 + | "create" -> 161 + Some Create 162 + | "update" -> 163 + Some Update 164 + | "delete" -> 165 + Some Delete 166 + | _ -> 167 + None 168 + 169 + let all_repo_actions = [Create; Update; Delete] 170 + 171 + let parse_repo_collection s = 172 + if s = "*" then Some All 173 + else if is_valid_nsid s then Some (Collection s) 174 + else None 175 + 176 + let parse_repo_permission positional params = 177 + let collection_strs = 178 + match positional with 179 + | Some p -> 180 + [p] 181 + | None -> 182 + get_all_params "collection" params 183 + in 184 + if collection_strs = [] then None 185 + else 186 + let collections = List.filter_map parse_repo_collection collection_strs in 187 + if collections = [] then None 188 + else 189 + let action_strs = get_all_params "action" params in 190 + let actions = 191 + if action_strs = [] then all_repo_actions 192 + else List.filter_map parse_repo_action action_strs 193 + in 194 + if actions = [] then None else Some {collections; actions} 195 + 196 + let parse_rpc_lxm s = 197 + if s = "*" then Some AnyLxm 198 + else if is_valid_nsid s then Some (Lxm s) 199 + else None 200 + 201 + let is_valid_atproto_audience s = 202 + let parts = String.split_on_char '#' s in 203 + match parts with 204 + | [did] | [did; _] -> ( 205 + match String.split_on_char ':' did with 206 + | "did" :: method_ :: _ when String.length method_ > 0 -> 207 + true 208 + | _ -> 209 + false ) 210 + | _ -> 211 + false 212 + 213 + let parse_rpc_aud s = 214 + if s = "*" then Some AnyAud 215 + else if is_valid_atproto_audience s then Some (Aud s) 216 + else None 217 + 218 + let parse_rpc_permission positional params = 219 + let lxm_strs = 220 + match positional with Some p -> [p] | None -> get_all_params "lxm" params 221 + in 222 + if lxm_strs = [] then None 223 + else 224 + let lxms = List.filter_map parse_rpc_lxm lxm_strs in 225 + if lxms = [] then None 226 + else 227 + match get_single_param "aud" params with 228 + | None -> 229 + None (* aud is required *) 230 + | Some aud_str -> ( 231 + match parse_rpc_aud aud_str with 232 + | None -> 233 + None 234 + | Some aud -> 235 + (* rpc:*?aud=* is forbidden *) 236 + if aud = AnyAud && List.mem AnyLxm lxms then None 237 + else Some {lxm= lxms; aud} ) 238 + 239 + let parse_accept_pattern s = 240 + if s = "*/*" then Some AnyMime 241 + else 242 + match String.split_on_char '/' s with 243 + | [type_; "*"] when String.length type_ > 0 -> 244 + Some (TypeWildcard type_) 245 + | [type_; subtype] 246 + when String.length type_ > 0 247 + && String.length subtype > 0 248 + && (not (String.contains type_ '*')) 249 + && not (String.contains subtype '*') -> 250 + Some (ExactMime (type_, subtype)) 251 + | _ -> 252 + None 253 + 254 + let parse_blob_permission positional params = 255 + let accept_strs = 256 + match positional with 257 + | Some p -> 258 + [p] 259 + | None -> 260 + get_all_params "accept" params 261 + in 262 + if accept_strs = [] then None 263 + else 264 + let accepts = List.filter_map parse_accept_pattern accept_strs in 265 + if accepts = [] then None else Some {accept= accepts} 266 + 267 + let parse_static_scope = function 268 + | "atproto" -> 269 + Some (Static Atproto) 270 + | "transition:email" -> 271 + Some (Static TransitionEmail) 272 + | "transition:generic" -> 273 + Some (Static TransitionGeneric) 274 + | "transition:chat.bsky" -> 275 + Some (Static TransitionChatBsky) 276 + | _ -> 277 + None 278 + 279 + let parse_scope s = 280 + match parse_static_scope s with 281 + | Some scope -> 282 + Some scope 283 + | None -> ( 284 + let prefix, positional, params = parse_scope_syntax s in 285 + match prefix with 286 + | "account" -> 287 + Option.map 288 + (fun p -> Account p) 289 + (parse_account_permission positional params) 290 + | "identity" -> 291 + Option.map 292 + (fun p -> Identity p) 293 + (parse_identity_permission positional params) 294 + | "repo" -> 295 + Option.map (fun p -> Repo p) (parse_repo_permission positional params) 296 + | "rpc" -> 297 + Option.map (fun p -> Rpc p) (parse_rpc_permission positional params) 298 + | "blob" -> 299 + Option.map (fun p -> Blob p) (parse_blob_permission positional params) 300 + | _ -> 301 + None ) 302 + 303 + let parse_scopes s = 304 + if s = "" then [] 305 + else 306 + String.split_on_char ' ' s 307 + |> List.filter (fun s -> s <> "") 308 + |> List.filter_map parse_scope 309 + 310 + type account_match = {attr: account_attr; action: account_action} 311 + 312 + type identity_match = {attr: identity_attr} 313 + 314 + type repo_match = {collection: string; action: repo_action} 315 + 316 + type rpc_match = {lxm: string; aud: string} 317 + 318 + type blob_match = {mime: string} 319 + 320 + let account_permission_matches (perm : account_permission) (opts : account_match) 321 + = 322 + perm.attr = opts.attr 323 + && (List.mem Manage perm.actions || List.mem opts.action perm.actions) 324 + 325 + let identity_permission_matches (perm : identity_permission) 326 + (opts : identity_match) = 327 + perm.attr = Any || perm.attr = opts.attr 328 + 329 + let repo_permission_matches perm (opts : repo_match) = 330 + List.mem opts.action perm.actions 331 + && ( List.mem All perm.collections 332 + || List.mem (Collection opts.collection) perm.collections ) 333 + 334 + let rpc_permission_matches (perm : rpc_permission) (opts : rpc_match) = 335 + (perm.aud = AnyAud || perm.aud = Aud opts.aud) 336 + && (List.mem AnyLxm perm.lxm || List.mem (Lxm opts.lxm) perm.lxm) 337 + 338 + let accept_matches_mime pattern mime = 339 + match pattern with 340 + | AnyMime -> 341 + true 342 + | TypeWildcard t -> ( 343 + match String.split_on_char '/' mime with 344 + | [type_; _subtype] 345 + when (not (String.contains type_ '*')) 346 + && not (String.contains _subtype '*') -> 347 + String.lowercase_ascii type_ = String.lowercase_ascii t 348 + | _ -> 349 + false ) 350 + | ExactMime (t, s) -> ( 351 + match String.split_on_char '/' mime with 352 + | [type_; subtype] 353 + when (not (String.contains type_ '*')) 354 + && not (String.contains subtype '*') -> 355 + String.lowercase_ascii type_ = String.lowercase_ascii t 356 + && String.lowercase_ascii subtype = String.lowercase_ascii s 357 + | _ -> 358 + false ) 359 + 360 + let blob_permission_matches perm (opts : blob_match) = 361 + List.exists (fun pat -> accept_matches_mime pat opts.mime) perm.accept 362 + 363 + type t = scope list 364 + 365 + let of_string s = parse_scopes s 366 + 367 + let of_list strs = List.filter_map parse_scope strs 368 + 369 + let allows_account scopes opts = 370 + List.exists 371 + (fun scope -> 372 + match scope with 373 + | Account perm -> 374 + account_permission_matches perm opts 375 + | _ -> 376 + false ) 377 + scopes 378 + 379 + let allows_identity scopes opts = 380 + List.exists 381 + (fun scope -> 382 + match scope with 383 + | Identity perm -> 384 + identity_permission_matches perm opts 385 + | _ -> 386 + false ) 387 + scopes 388 + 389 + let allows_repo scopes opts = 390 + List.exists 391 + (fun scope -> 392 + match scope with 393 + | Repo perm -> 394 + repo_permission_matches perm opts 395 + | _ -> 396 + false ) 397 + scopes 398 + 399 + let allows_rpc scopes opts = 400 + List.exists 401 + (fun scope -> 402 + match scope with 403 + | Rpc perm -> 404 + rpc_permission_matches perm opts 405 + | _ -> 406 + false ) 407 + scopes 408 + 409 + let allows_blob scopes opts = 410 + List.exists 411 + (fun scope -> 412 + match scope with 413 + | Blob perm -> 414 + blob_permission_matches perm opts 415 + | _ -> 416 + false ) 417 + scopes 418 + 419 + let has_atproto scopes = List.mem (Static Atproto) scopes 420 + 421 + let has_transition_email scopes = List.mem (Static TransitionEmail) scopes 422 + 423 + let has_transition_generic scopes = List.mem (Static TransitionGeneric) scopes 424 + 425 + let has_transition_chat_bsky scopes = 426 + List.mem (Static TransitionChatBsky) scopes