Implement OAuth #2

.ocamlformat

This file has not been changed.

bin/main.ml

This file has not been changed.

dune

This file has not been changed.

-1

dune-project

··· 30 (url "git+https://github.com/roddyyaga/ppx_rapper.git") 31 (package (name ppx_rapper_lwt))) 32 33 - 34 (package 35 (name pegasus) 36 (synopsis "An atproto Personal Data Server implementation")

··· 30 (url "git+https://github.com/roddyyaga/ppx_rapper.git") 31 (package (name ppx_rapper_lwt))) 32 0 33 (package 34 (name pegasus) 35 (synopsis "An atproto Personal Data Server implementation")

kleidos/kleidos.ml

This file has not been changed.

mist/lib/mst.ml

This patch was likely rebased, as context lines do not match.

pegasus.opam

This file has not been changed.

pegasus/lib/api/account_/login.ml

This file has not been changed.

pegasus/lib/api/account_/logout.ml

This file has not been changed.

pegasus/lib/api/actor/putPreferences.ml

This file has not been changed.

pegasus/lib/api/identity/updateHandle.ml

This patch was likely rebased, as context lines do not match.

pegasus/lib/api/oauth_/authorize.ml

This file has not been changed.

pegasus/lib/api/oauth_/par.ml

This file has not been changed.

pegasus/lib/api/oauth_/token.ml

This file has not been changed.

pegasus/lib/api/server/createSession.ml

This file has not been changed.

pegasus/lib/api/server/getServiceAuth.ml

This file has not been changed.

pegasus/lib/api/well_known.ml

This file has not been changed.

pegasus/lib/auth.ml

This patch was likely rebased, as context lines do not match.

pegasus/lib/data_store.ml

This patch was likely rebased, as context lines do not match.

pegasus/lib/dune

This file has not been changed.

pegasus/lib/env.ml

This file has not been changed.

pegasus/lib/errors.ml

This file has not been changed.

pegasus/lib/id_resolver.ml

This file has not been changed.

pegasus/lib/jwt.ml

This patch was likely rebased, as context lines do not match.

pegasus/lib/oauth/client.ml

This file has not been changed.

pegasus/lib/oauth/constants.ml

This file has not been changed.

pegasus/lib/oauth/dpop.ml

This file has not been changed.

pegasus/lib/oauth/queries.ml

This file has not been changed.

pegasus/lib/oauth/types.ml

This file has not been changed.

pegasus/lib/plc.ml

This file has not been changed.

pegasus/lib/templates/components/button.mlx

This file has not been changed.

pegasus/lib/templates/components/input.mlx

This file has not been changed.

pegasus/lib/templates/icons/circle_alert.mlx

This file has not been changed.

pegasus/lib/templates/layout.mlx

This file has not been changed.

pegasus/lib/templates/login.mlx

This file has not been changed.

pegasus/lib/templates/oauth_authorize.mlx

This file has not been changed.

pegasus/lib/util.ml

This patch was likely rebased, as context lines do not match.

pegasus/lib/xrpc.ml

This patch was likely rebased, as context lines do not match.

public/fonts/Fragment.woff

Failed to calculate interdiff for this file.

public/fonts/Fragment.woff2

Failed to calculate interdiff for this file.

public/main.css

This file has not been changed.

tailwindcss.opam

This file has not been changed.

tools/tailwindcss/dune

This file has not been changed.

+2 -2

ipld/lib/dag_cbor.ml

··· 197 write_type_and_argument t 5 (Int64.of_int len) ; 198 ordered_map_keys m 199 |> List.iter (fun k -> 200 - write_string t k ; 201 - write_value t (String_map.find k m) ) 202 | `Link cid -> 203 write_cid t cid 204

··· 197 write_type_and_argument t 5 (Int64.of_int len) ; 198 ordered_map_keys m 199 |> List.iter (fun k -> 200 + write_string t k ; 201 + write_value t (String_map.find k m) ) 202 | `Link cid -> 203 write_cid t cid 204

+4 -4

ipld/test/test_dag_cbor.ml

··· 3 let rec stringify_map m = 4 String_map.bindings m 5 |> List.map (fun (k, v) -> 6 - Format.sprintf "\"%s\": %s" k (stringify_ipld_value v) ) 7 |> String.concat ", " |> Format.sprintf "{%s}" 8 9 and stringify_ipld_value (value : Dag_cbor.value) = ··· 109 Hashtbl.add cases (to_base_16 (Dag_cbor.encode `Null)) (Bytes.of_string "f6") ; 110 cases 111 |> Hashtbl.iter (fun key value -> 112 - Alcotest.(check bytes) 113 - ("encoded bytes for " ^ key) 114 - value (Bytes.of_string key) ) 115 116 let test_round_trip () = 117 let test_cid =

··· 3 let rec stringify_map m = 4 String_map.bindings m 5 |> List.map (fun (k, v) -> 6 + Format.sprintf "\"%s\": %s" k (stringify_ipld_value v) ) 7 |> String.concat ", " |> Format.sprintf "{%s}" 8 9 and stringify_ipld_value (value : Dag_cbor.value) = ··· 109 Hashtbl.add cases (to_base_16 (Dag_cbor.encode `Null)) (Bytes.of_string "f6") ; 110 cases 111 |> Hashtbl.iter (fun key value -> 112 + Alcotest.(check bytes) 113 + ("encoded bytes for " ^ key) 114 + value (Bytes.of_string key) ) 115 116 let test_round_trip () = 117 let test_cid =

+7 -7

mist/test/test_util.ml

··· 8 Hashtbl.add cases "app.bsky.feed.post/9adeb165882c" 8 ; 9 cases 10 |> Hashtbl.iter (fun key value -> 11 - Alcotest.(check int) 12 - ("leading zeros on hash " ^ key) 13 - value 14 - (leading_zeros_on_hash key) ) 15 16 let test_shared_prefix_length () = 17 let cases = Hashtbl.create 5 in ··· 22 Hashtbl.add cases ("2653ae71", "0653ae71") 0 ; 23 cases 24 |> Hashtbl.iter (fun (a, b) value -> 25 - Alcotest.(check int) 26 - ("prefix length between " ^ a ^ " and " ^ b) 27 - value (shared_prefix_length a b) ) 28 29 let () = 30 Alcotest.run "util"

··· 8 Hashtbl.add cases "app.bsky.feed.post/9adeb165882c" 8 ; 9 cases 10 |> Hashtbl.iter (fun key value -> 11 + Alcotest.(check int) 12 + ("leading zeros on hash " ^ key) 13 + value 14 + (leading_zeros_on_hash key) ) 15 16 let test_shared_prefix_length () = 17 let cases = Hashtbl.create 5 in ··· 22 Hashtbl.add cases ("2653ae71", "0653ae71") 0 ; 23 cases 24 |> Hashtbl.iter (fun (a, b) value -> 25 + Alcotest.(check int) 26 + ("prefix length between " ^ a ^ " and " ^ b) 27 + value (shared_prefix_length a b) ) 28 29 let () = 30 Alcotest.run "util"

+6 -6

pegasus/lib/api/identity/resolveHandle.ml

··· 14 Dream.json @@ Yojson.Safe.to_string 15 @@ response_to_yojson {did= actor.did} 16 | None -> ( 17 - match%lwt Id_resolver.Handle.resolve handle with 18 - | Ok did -> 19 - Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson {did} 20 - | Error e -> 21 - Errors.log_exn (Failure e) ; 22 - Errors.internal_error ~msg:"could not resolve handle" () ) )

··· 14 Dream.json @@ Yojson.Safe.to_string 15 @@ response_to_yojson {did= actor.did} 16 | None -> ( 17 + match%lwt Id_resolver.Handle.resolve handle with 18 + | Ok did -> 19 + Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson {did} 20 + | Error e -> 21 + Errors.log_exn (Failure e) ; 22 + Errors.internal_error ~msg:"could not resolve handle" () ) )

+10 -10

pegasus/lib/api/repo/createAccount.ml

··· 57 let%lwt did = 58 match input.did with 59 | Some did -> ( 60 - match%lwt Data_store.get_actor_by_identifier did ctx.db with 61 - | Some _ -> 62 - Errors.invalid_request "an account with that did already exists" 63 - | None -> 64 - Lwt.return did ) 65 | None -> ( 66 let sk_did = Kleidos.K256.pubkey_to_did_key signing_pubkey in 67 let rotation_did_keys = ··· 79 let%lwt _ = 80 match input.invite_code with 81 | Some code -> ( 82 - match%lwt Data_store.use_invite ~code ctx.db with 83 - | Some _ -> 84 - Lwt.return () 85 - | None -> 86 - failwith "failed to use invite code" ) 87 | None -> 88 Lwt.return () 89 in

··· 57 let%lwt did = 58 match input.did with 59 | Some did -> ( 60 + match%lwt Data_store.get_actor_by_identifier did ctx.db with 61 + | Some _ -> 62 + Errors.invalid_request "an account with that did already exists" 63 + | None -> 64 + Lwt.return did ) 65 | None -> ( 66 let sk_did = Kleidos.K256.pubkey_to_did_key signing_pubkey in 67 let rotation_did_keys = ··· 79 let%lwt _ = 80 match input.invite_code with 81 | Some code -> ( 82 + match%lwt Data_store.use_invite ~code ctx.db with 83 + | Some _ -> 84 + Lwt.return () 85 + | None -> 86 + failwith "failed to use invite code" ) 87 | None -> 88 Lwt.return () 89 in

+11 -11

pegasus/lib/repository.ml

··· 180 let%lwt map = get_map t in 181 String_map.bindings map 182 |> List.filter (fun (path, _) -> 183 - String.starts_with ~prefix:(path ^ "/") collection ) 184 |> Lwt_list.fold_left_s 185 (fun acc (path, cid) -> 186 match%lwt User_store.get_record t.db path with ··· 320 let%lwt () = 321 match old_cid with 322 | Some _ -> ( 323 - match%lwt User_store.get_record t.db path with 324 - | Some record -> 325 - let refs = 326 - Util.find_blob_refs record.value 327 - |> List.map (fun (r : Mist.Blob_ref.t) -> r.ref) 328 - in 329 - let%lwt () = User_store.clear_blob_refs t.db path refs in 330 - Lwt.return_unit 331 - | None -> 332 - Lwt.return_unit ) 333 | None -> 334 Lwt.return_unit 335 in

··· 180 let%lwt map = get_map t in 181 String_map.bindings map 182 |> List.filter (fun (path, _) -> 183 + String.starts_with ~prefix:(path ^ "/") collection ) 184 |> Lwt_list.fold_left_s 185 (fun acc (path, cid) -> 186 match%lwt User_store.get_record t.db path with ··· 320 let%lwt () = 321 match old_cid with 322 | Some _ -> ( 323 + match%lwt User_store.get_record t.db path with 324 + | Some record -> 325 + let refs = 326 + Util.find_blob_refs record.value 327 + |> List.map (fun (r : Mist.Blob_ref.t) -> r.ref) 328 + in 329 + let%lwt () = User_store.clear_blob_refs t.db path refs in 330 + Lwt.return_unit 331 + | None -> 332 + Lwt.return_unit ) 333 | None -> 334 Lwt.return_unit 335 in

+28 -28

pegasus/lib/sequencer.ml

··· 330 let blobs = 331 j |> member "blobs" |> to_list 332 |> List.filter_map (fun x -> 333 - match Cid.of_yojson x with Ok c -> Some c | _ -> None ) 334 in 335 let prev_data = 336 match j |> member "prevData" with ··· 342 let ops = 343 j |> member "ops" |> to_list 344 |> List.map (fun opj -> 345 - let action = 346 - match opj |> member "action" |> to_string with 347 - | "create" -> 348 - `Create 349 - | "update" -> 350 - `Update 351 - | "delete" -> 352 - `Delete 353 - | _ -> 354 - `Create 355 - in 356 - let path = opj |> member "path" |> to_string in 357 - let cid = 358 - match opj |> member "cid" with 359 - | `Null -> 360 - None 361 - | v -> ( 362 - match Cid.of_yojson v with Ok c -> Some c | _ -> None ) 363 - in 364 - let prev = 365 - match opj |> member "prev" with 366 - | `Null -> 367 - None 368 - | v -> ( 369 - match Cid.of_yojson v with Ok c -> Some c | _ -> None ) 370 - in 371 - {action; path; cid; prev} ) 372 in 373 Ok 374 { rebase

··· 330 let blobs = 331 j |> member "blobs" |> to_list 332 |> List.filter_map (fun x -> 333 + match Cid.of_yojson x with Ok c -> Some c | _ -> None ) 334 in 335 let prev_data = 336 match j |> member "prevData" with ··· 342 let ops = 343 j |> member "ops" |> to_list 344 |> List.map (fun opj -> 345 + let action = 346 + match opj |> member "action" |> to_string with 347 + | "create" -> 348 + `Create 349 + | "update" -> 350 + `Update 351 + | "delete" -> 352 + `Delete 353 + | _ -> 354 + `Create 355 + in 356 + let path = opj |> member "path" |> to_string in 357 + let cid = 358 + match opj |> member "cid" with 359 + | `Null -> 360 + None 361 + | v -> ( 362 + match Cid.of_yojson v with Ok c -> Some c | _ -> None ) 363 + in 364 + let prev = 365 + match opj |> member "prev" with 366 + | `Null -> 367 + None 368 + | v -> ( 369 + match Cid.of_yojson v with Ok c -> Some c | _ -> None ) 370 + in 371 + {action; path; cid; prev} ) 372 in 373 Ok 374 { rebase

+2 -2

pegasus/lib/user_store.ml

··· 386 let get_record t path : record option Lwt.t = 387 Util.use_pool t.db @@ Queries.get_record ~path 388 >|= Option.map (fun (cid, data, since) -> 389 - {path; cid; value= Lex.of_cbor data; since} ) 390 391 let list_records t ?(limit = 100) ?(cursor = "") ?(reverse = false) collection : 392 record list Lwt.t = ··· 395 in 396 Util.use_pool t.db @@ fn ~collection ~limit ~cursor 397 >|= List.map (fun (path, cid, data, since) -> 398 - {path; cid; value= Lex.of_cbor data; since} ) 399 400 let put_record t record path : (Cid.t * bytes) Lwt.t = 401 let cid, data = Lex.to_cbor_block record in

··· 386 let get_record t path : record option Lwt.t = 387 Util.use_pool t.db @@ Queries.get_record ~path 388 >|= Option.map (fun (cid, data, since) -> 389 + {path; cid; value= Lex.of_cbor data; since} ) 390 391 let list_records t ?(limit = 100) ?(cursor = "") ?(reverse = false) collection : 392 record list Lwt.t = ··· 395 in 396 Util.use_pool t.db @@ fn ~collection ~limit ~cursor 397 >|= List.map (fun (path, cid, data, since) -> 398 + {path; cid; value= Lex.of_cbor data; since} ) 399 400 let put_record t record path : (Cid.t * bytes) Lwt.t = 401 let cid, data = Lex.to_cbor_block record in