Implement OAuth #2

···

       
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
       
 
       


     

···

       
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 =

     

···

       
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"

     

···

       
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" () ) )

     

···

       
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

     

···

       
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

     

···

       
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

     

···

       
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