objective categorical abstract machine language personal data server
Return full exclusion proof for nonexistent mst entries
+63
-83
+63
-83
mist/lib/mst.ml
+63
-83
mist/lib/mst.ml
···
82
82
83
83
val build_map : t -> Cid.t StringMap.t Lwt.t
84
84
85
-
val path_to_entry : t -> Cid.t -> string -> (Cid.t * bytes) list Lwt.t
86
-
87
85
val to_blocks_stream : t -> (Cid.t * bytes) Lwt_seq.t
88
86
89
87
val serialize : t -> node -> (Cid.t * bytes, exn) Lwt_result.t
88
+
89
+
val proof_for_key : t -> Cid.t -> string -> Block_map.t Lwt.t
90
90
91
91
val get_covering_proof : t -> string -> Storage.Block_map.t Lwt.t
92
92
···
273
273
in
274
274
Lwt.return !map
275
275
276
-
(* returns cids and blocks that form the path from a given node to a given entry *)
277
-
let rec path_to_entry t node key : (Cid.t * bytes) list Lwt.t =
278
-
let%lwt root_bytes = Store.get_bytes t.blockstore node in
279
-
let%lwt root_raw =
280
-
match root_bytes with
281
-
| None ->
282
-
Lwt.return_none
283
-
| Some bytes ->
284
-
Lwt.return_some (decode_block_raw bytes)
285
-
in
286
-
let%lwt root =
287
-
match root_raw with
288
-
| None ->
289
-
Lwt.return_none
290
-
| Some root ->
291
-
hydrate_node t root |> Lwt.map Option.some
292
-
in
293
-
(* if there is a left child, try to find a path through the left subtree *)
294
-
let%lwt path_through_left =
295
-
match root_raw with
296
-
| None ->
297
-
Lwt.return_some []
298
-
| Some raw -> (
299
-
match raw.l with
300
-
| None ->
301
-
Lwt.return_none
302
-
| Some left -> (
303
-
match%lwt path_to_entry t left key with
304
-
| [] ->
305
-
Lwt.return_none
306
-
| path ->
307
-
(* Option.get is safe because root is Some only when root_bytes is Some *)
308
-
Lwt.return_some (path @ [(node, Option.get root_bytes)]) ) )
309
-
in
310
-
match path_through_left with
311
-
| Some path ->
312
-
Lwt.return path
313
-
| None -> (
314
-
(* if a left subtree path couldn't be found, find the entry whose right subtree this key would belong to *)
315
-
(* this branch is only reached when root/root_raw/root_bytes are not None;
316
-
if they were, path_through_left would be Some [] *)
317
-
let entries = (Option.get root).entries in
318
-
let entries_len = List.length entries in
319
-
let entry_index =
320
-
match List.find_index (fun (e : entry) -> e.key >= key) entries with
321
-
| Some index ->
322
-
index
323
-
| None ->
324
-
entries_len
325
-
in
326
-
(* path_through_left is None -> root_bytes is Some *)
327
-
let path_tail = [(node, Option.get root_bytes)] in
328
-
(* entry_index here is actually the entry to the right of the subtree the key would belong to *)
329
-
match entry_index with
330
-
| _
331
-
(* because entries[entry_index] might turn out to be the entry we're looking for *)
332
-
when entry_index < entries_len
333
-
&& (List.nth entries entry_index).key = key ->
334
-
Lwt.return path_tail
335
-
| _ -> (
336
-
(* otherwise, we continue down the right subtree of the entry before entry_index *)
337
-
(* path_through_left is None -> root_raw is Some *)
338
-
match Util.last (Option.get root_raw).e with
339
-
| Some last when last.t <> None ->
340
-
let%lwt path_through_right =
341
-
(* when last.t <> None *)
342
-
path_to_entry t (Option.get last.t) key
343
-
in
344
-
Lwt.return (path_through_right @ path_tail)
345
-
| _ ->
346
-
Lwt.return path_tail ) )
347
-
348
276
(* returns all mst entries in order for a car stream *)
349
277
let to_blocks_stream t : (Cid.t * bytes) Lwt_seq.t =
350
278
let module M = struct
···
556
484
let keys = node_entry_keys raw in
557
485
let seq = interleave_raw raw keys in
558
486
let index = find_gte_leaf_index key seq in
559
-
let blocks_lwt =
487
+
let%lwt blocks =
560
488
match Util.at_index index seq with
561
-
| Some (Leaf (k, _, _)) when k = key ->
562
-
Lwt.return Block_map.empty
489
+
| Some (Leaf (k, v, _)) when k = key -> (
490
+
(* include the found leaf block to prove existence *)
491
+
match%lwt Store.get_bytes t.blockstore v with
492
+
| Some leaf_bytes ->
493
+
Lwt.return (Block_map.set v leaf_bytes Block_map.empty)
494
+
| None ->
495
+
Lwt.return Block_map.empty )
563
496
| _ -> (
564
497
let prev =
565
498
if index - 1 >= 0 then Util.at_index (index - 1) seq else None
···
568
501
| Some (Tree c) ->
569
502
proof_for_key t c key
570
503
| _ ->
571
-
Lwt.return Block_map.empty )
504
+
(* include bounding neighbor leaf blocks (if any) to prove nonexistence *)
505
+
let left_leaf =
506
+
match prev with
507
+
| Some (Leaf (_, v_left, _)) ->
508
+
Some v_left
509
+
| _ ->
510
+
None
511
+
in
512
+
let right_leaf =
513
+
match Util.at_index index seq with
514
+
| Some (Leaf (_, v_right, _)) ->
515
+
Some v_right
516
+
| _ ->
517
+
None
518
+
in
519
+
let%lwt bm =
520
+
match left_leaf with
521
+
| Some cid_left -> (
522
+
match%lwt Store.get_bytes t.blockstore cid_left with
523
+
| Some b ->
524
+
Lwt.return
525
+
(Block_map.set cid_left b Block_map.empty)
526
+
| None ->
527
+
Lwt.return Block_map.empty )
528
+
| None ->
529
+
Lwt.return Block_map.empty
530
+
in
531
+
let%lwt bm =
532
+
match right_leaf with
533
+
| Some cid_right -> (
534
+
match%lwt Store.get_bytes t.blockstore cid_right with
535
+
| Some b ->
536
+
Lwt.return (Block_map.set cid_right b bm)
537
+
| None ->
538
+
Lwt.return bm )
539
+
| None ->
540
+
Lwt.return bm
541
+
in
542
+
Lwt.return bm )
572
543
in
573
-
let%lwt blocks = blocks_lwt in
574
544
Lwt.return (Block_map.set cid bytes blocks)
575
545
576
546
(* returns all mst nodes needed to prove the value of a given key's left sibling *)
···
583
553
let keys = node_entry_keys raw in
584
554
let seq = interleave_raw raw keys in
585
555
let index = find_gte_leaf_index key seq in
586
-
let blocks_lwt =
556
+
let%lwt blocks =
587
557
let prev =
588
558
if index - 1 >= 0 then Util.at_index (index - 1) seq else None
589
559
in
590
560
match prev with
591
561
| Some (Tree c) ->
592
562
proof_for_left_sibling t c key
563
+
| Some (Leaf (_, v_left, _)) -> (
564
+
match%lwt Store.get_bytes t.blockstore v_left with
565
+
| Some b ->
566
+
Lwt.return (Block_map.set v_left b Block_map.empty)
567
+
| None ->
568
+
Lwt.return Block_map.empty )
593
569
| _ ->
594
570
Lwt.return Block_map.empty
595
571
in
596
-
let%lwt blocks = blocks_lwt in
597
572
Lwt.return (Block_map.set cid bytes blocks)
598
573
599
574
(* returns all mst nodes needed to prove the value of a given key's right sibling *)
···
613
588
| some ->
614
589
some
615
590
in
616
-
let blocks_lwt =
591
+
let%lwt blocks =
617
592
match found with
618
593
| Some (Tree c) ->
619
594
proof_for_right_sibling t c key
···
626
601
match neighbor with
627
602
| Some (Tree c) ->
628
603
proof_for_right_sibling t c key
604
+
| Some (Leaf (_, v_right, _)) -> (
605
+
match%lwt Store.get_bytes t.blockstore v_right with
606
+
| Some b ->
607
+
Lwt.return (Block_map.set v_right b Block_map.empty)
608
+
| None ->
609
+
Lwt.return Block_map.empty )
629
610
| _ ->
630
611
Lwt.return Block_map.empty )
631
612
| None ->
632
613
Lwt.return Block_map.empty
633
614
in
634
-
let%lwt blocks = blocks_lwt in
635
615
Lwt.return (Block_map.set cid bytes blocks)
636
616
637
617
(* a covering proof is all mst nodes needed to prove the value of a given leaf