+60 -53

mist/lib/mst.ml

reviewed

··· 49 49 let%lwt result = Lazy.force lazy_opt_lwt in 50 50 f result 51 51 52 52 - (* produces a cid and cbor-encoded bytes for a given tree *) 53 53 - let serialize node : (Cid.t * bytes) Lwt.t = 54 54 - let sorted_entries = 55 55 - List.sort (fun a b -> String.compare a.key b.key) node.entries 56 56 - in 57 57 - let rec aux node = 58 58 - let%lwt left = 59 59 - node.left 60 60 - >>? function 61 61 - | Some l -> 62 62 - let%lwt cid, _ = aux l in 63 63 - Lwt.return_some cid 64 64 - | None -> 65 65 - Lwt.return_none 66 66 - in 67 67 - let last_key = ref "" in 68 68 - let%lwt mst_entries = 69 69 - Lwt_list.map_s 70 70 - (fun entry -> 71 71 - let%lwt right = 72 72 - entry.right 73 73 - >>? function 74 74 - | Some r -> 75 75 - let%lwt cid, _ = aux r in 76 76 - Lwt.return (Some cid) 77 77 - | None -> 78 78 - Lwt.return None 79 79 - in 80 80 - let prefix_len = Util.shared_prefix_length !last_key entry.key in 81 81 - last_key := entry.key ; 82 82 - Lwt.return 83 83 - { k= 84 84 - Bytes.of_string 85 85 - (String.sub entry.key prefix_len 86 86 - (String.length entry.key - prefix_len) ) 87 87 - ; p= prefix_len 88 88 - ; v= entry.value 89 89 - ; t= right } ) 90 90 - node.entries 91 91 - in 92 92 - let encoded = Dag_cbor.encode (encode_node_raw {l= left; e= mst_entries}) in 93 93 - let cid = Cid.create Dcbor encoded in 94 94 - Lwt.return (cid, encoded) 95 95 - in 96 96 - aux {node with entries= sorted_entries} 97 97 - 98 52 module Make (Store : Writable_blockstore) = struct 99 53 type bs = Store.t 100 54 ··· 432 386 let to_car t : bytes Lwt.t = 433 387 t |> to_blocks_stream |> Car.blocks_to_car (Some t.root) 434 388 389 389 + (* produces a cid and cbor-encoded bytes for a given tree *) 390 390 + let serialize t node : (Cid.t * bytes, exn) Lwt_result.t = 391 391 + let sorted_entries = 392 392 + List.sort (fun a b -> String.compare a.key b.key) node.entries 393 393 + in 394 394 + let rec aux node : (Cid.t * bytes) Lwt.t = 395 395 + let%lwt left = 396 396 + node.left 397 397 + >>? function 398 398 + | Some l -> 399 399 + let%lwt cid, _ = aux l in 400 400 + Lwt.return_some cid 401 401 + | None -> 402 402 + Lwt.return_none 403 403 + in 404 404 + let last_key = ref "" in 405 405 + let%lwt mst_entries = 406 406 + Lwt_list.map_s 407 407 + (fun entry -> 408 408 + let%lwt right = 409 409 + entry.right 410 410 + >>? function 411 411 + | Some r -> 412 412 + let%lwt cid, _ = aux r in 413 413 + Lwt.return_some cid 414 414 + | None -> 415 415 + Lwt.return_none 416 416 + in 417 417 + let prefix_len = Util.shared_prefix_length !last_key entry.key in 418 418 + last_key := entry.key ; 419 419 + Lwt.return 420 420 + { k= 421 421 + Bytes.of_string 422 422 + (String.sub entry.key prefix_len 423 423 + (String.length entry.key - prefix_len) ) 424 424 + ; p= prefix_len 425 425 + ; v= entry.value 426 426 + ; t= right } ) 427 427 + node.entries 428 428 + in 429 429 + let encoded = 430 430 + Dag_cbor.encode (encode_node_raw {l= left; e= mst_entries}) 431 431 + in 432 432 + let cid = Cid.create Dcbor encoded in 433 433 + match%lwt Store.put_block t.blockstore cid encoded with 434 434 + | Ok _ -> 435 435 + Lwt.return (cid, encoded) 436 436 + | Error e -> 437 437 + raise e 438 438 + in 439 439 + try%lwt Lwt.map Result.ok (aux {node with entries= sorted_entries}) 440 440 + with e -> Lwt.return_error e 441 441 + 435 442 (* raw-node helpers for covering proofs: operate on stored bytes, not re-serialization *) 436 443 type interleaved_entry = 437 444 | Tree of Cid.t ··· 728 735 Lwt.return sorted 729 736 730 737 (* creates and persists an empty mst *) 731 731 - let create_empty blockstore : t Lwt.t = 738 738 + let create_empty blockstore : (t, exn) Lwt_result.t = 732 739 let encoded = Dag_cbor.encode (encode_node_raw {l= None; e= []}) in 733 740 let cid = Cid.create Dcbor encoded in 734 734 - let%lwt () = Store.put_block blockstore cid encoded in 735 735 - Lwt.return {blockstore; root= cid} 741 741 + Lwt_result.bind (Store.put_block blockstore cid encoded) (fun _ -> 742 742 + Lwt.return_ok {blockstore; root= cid} ) 736 743 737 744 (* returns the cid for a given key, if it exists *) 738 745 let get_cid t key : Cid.t option Lwt.t = ··· 795 802 | [] -> 796 803 let encoded = Dag_cbor.encode (encode_node_raw {l= None; e= []}) in 797 804 let cid = Cid.create Dcbor encoded in 798 798 - Store.put_block blockstore cid encoded >|= fun () -> (cid, 0) 805 805 + Store.put_block blockstore cid encoded >|= fun _ -> (cid, 0) 799 806 | _ -> 800 807 let with_layers = 801 808 List.map (fun (k, v) -> (k, v, Util.leading_zeros_on_hash k)) pairs ··· 833 840 in 834 841 let cid' = Cid.create Dcbor encoded in 835 842 Store.put_block blockstore cid' encoded 836 836 - >>= fun () -> wrap cid' (layer + 1) 843 843 + >>= fun _ -> wrap cid' (layer + 1) 837 844 in 838 845 wrap cid child_layer >|= fun c -> Some c 839 846 in ··· 874 881 in 875 882 let cid' = Cid.create Dcbor encoded in 876 883 Store.put_block blockstore cid' encoded 877 877 - >>= fun () -> wrap cid' (layer + 1) 884 884 + >>= fun _ -> wrap cid' (layer + 1) 878 885 in 879 886 wrap cid child_layer >|= fun c -> Some c ) 880 887 rights ··· 895 902 let node_raw = {l= l_cid; e= entries_raw} in 896 903 let encoded = Dag_cbor.encode (encode_node_raw node_raw) in 897 904 let cid = Cid.create Dcbor encoded in 898 898 - Store.put_block blockstore cid encoded >|= fun () -> (cid, root_layer) 905 905 + Store.put_block blockstore cid encoded >|= fun _ -> (cid, root_layer) 899 906 in 900 907 persist_from_sorted sorted >|= fun (root, _) -> {blockstore; root} 901 908

+4 -4

mist/lib/storage/blockstore.ml

reviewed

··· 13 13 14 14 include Readable with type t := t 15 15 16 16 - val put_block : t -> Cid.t -> bytes -> unit Lwt.t 16 16 + val put_block : t -> Cid.t -> bytes -> (bool, exn) Lwt_result.t 17 17 18 18 - val put_many : t -> Block_map.t -> unit Lwt.t 18 18 + val put_many : t -> Block_map.t -> (int, exn) Lwt_result.t 19 19 20 20 - val delete_block : t -> Cid.t -> unit Lwt.t 20 20 + val delete_block : t -> Cid.t -> (bool, exn) Lwt_result.t 21 21 22 22 - val delete_many : t -> Cid.t list -> unit Lwt.t 22 22 + val delete_many : t -> Cid.t list -> (int, exn) Lwt_result.t 23 23 end

+4 -4

mist/lib/storage/memory_blockstore.ml

reviewed

··· 11 11 12 12 let put_block s cid bytes = 13 13 s.blocks <- Block_map.set cid bytes s.blocks ; 14 14 - Lwt.return_unit 14 14 + Lwt.return_ok true 15 15 16 16 let put_many s blocks = 17 17 s.blocks <- Block_map.merge s.blocks blocks ; 18 18 - Lwt.return_unit 18 18 + Lwt.return_ok (Block_map.size blocks) 19 19 20 20 let delete_block s cid = 21 21 s.blocks <- Block_map.remove cid s.blocks ; 22 22 - Lwt.return_unit 22 22 + Lwt.return_ok true 23 23 24 24 let delete_many s cids = 25 25 s.blocks <- 26 26 List.fold_left 27 27 (fun blocks cid -> Block_map.remove cid blocks) 28 28 s.blocks cids ; 29 29 - Lwt.return_unit 29 29 + Lwt.return_ok (List.length cids) 30 30 end

+91 -87

mist/test/test_mst.ml

reviewed

··· 1 1 open Mist 2 2 open Lwt.Infix 3 3 + open Lwt_result.Syntax 3 4 module MemMst = Mst.Make (Storage.Memory_blockstore) 4 5 module StringMap = Dag_cbor.StringMap 5 6 ··· 50 51 51 52 let test_two_deep_split () = 52 53 let store = Storage.Memory_blockstore.create () in 53 53 - let%lwt mst = MemMst.create_empty store in 54 54 + let* mst = MemMst.create_empty store in 54 55 let%lwt mst = MemMst.add mst Keys.a0 leaf_cid in 55 56 let%lwt mst = MemMst.add mst Keys.b1 leaf_cid in 56 57 let%lwt mst = MemMst.add mst Keys.c0 leaf_cid in ··· 66 67 (Option.value 67 68 (Option.map (fun x -> Cid.equal leaf_cid x) got) 68 69 ~default:false ) ; 69 69 - Lwt.return_unit 70 70 + Lwt.return_ok () 70 71 71 72 let test_two_deep_leafless_splits () = 72 73 let store = Storage.Memory_blockstore.create () in 73 73 - let%lwt mst = MemMst.create_empty store in 74 74 + let* mst = MemMst.create_empty store in 74 75 let%lwt mst = MemMst.add mst Keys.a0 leaf_cid in 75 76 let%lwt mst = MemMst.add mst Keys.b0 leaf_cid in 76 77 let%lwt mst = MemMst.add mst Keys.d0 leaf_cid in ··· 84 85 (Option.value 85 86 (Option.map (fun x -> Cid.equal leaf_cid x) got) 86 87 ~default:false ) ; 87 87 - Lwt.return_unit 88 88 + Lwt.return_ok () 88 89 89 90 let test_add_on_edge_with_neighbor_two_layers_down () = 90 91 let store = Storage.Memory_blockstore.create () in 91 91 - let%lwt mst = MemMst.create_empty store in 92 92 + let* mst = MemMst.create_empty store in 92 93 let%lwt mst = MemMst.add mst Keys.a0 leaf_cid in 93 94 let%lwt mst = MemMst.add mst Keys.b2 leaf_cid in 94 95 let%lwt mst = MemMst.add mst Keys.c0 leaf_cid in ··· 101 102 (Option.value 102 103 (Option.map (fun x -> Cid.equal leaf_cid x) got) 103 104 ~default:false ) ; 104 104 - Lwt.return_unit 105 105 + Lwt.return_ok () 105 106 106 107 let test_merge_and_split_in_multi_op_commit () = 107 108 let store = Storage.Memory_blockstore.create () in 108 108 - let%lwt mst = MemMst.create_empty store in 109 109 + let* mst = MemMst.create_empty store in 109 110 let%lwt mst = MemMst.add mst Keys.b0 leaf_cid in 110 111 let%lwt mst = MemMst.add mst Keys.c2 leaf_cid in 111 112 let%lwt mst = MemMst.add mst Keys.d0 leaf_cid in ··· 137 138 let%lwt got_d2 = MemMst.get_cid proof_mst Keys.d2 in 138 139 Alcotest.(check bool) 139 140 "covering proof proves non-membership of d2" true (got_d2 = None) ; 140 140 - Lwt.return_unit 141 141 + Lwt.return_ok () 141 142 142 143 let test_complex_multi_op_commit () = 143 144 let store = Storage.Memory_blockstore.create () in 144 144 - let%lwt mst = MemMst.create_empty store in 145 145 + let* mst = MemMst.create_empty store in 145 146 let%lwt mst = MemMst.add mst Keys.b0 leaf_cid in 146 147 let%lwt mst = MemMst.add mst Keys.c2 leaf_cid in 147 148 let%lwt mst = MemMst.add mst Keys.d0 leaf_cid in ··· 176 177 let%lwt got_c2 = MemMst.get_cid proof_mst Keys.c2 in 177 178 Alcotest.(check bool) 178 179 "covering proof proves non-membership of c2" true (got_c2 = None) ; 179 179 - Lwt.return_unit 180 180 + Lwt.return_ok () 180 181 181 182 let test_trims_top_on_delete () = 182 183 let store = Storage.Memory_blockstore.create () in ··· 186 187 in 187 188 let l1root = "bafyreifnqrwbk6ffmyaz5qtujqrzf5qmxf7cbxvgzktl4e3gabuxbtatv4" in 188 189 let l0root = "bafyreie4kjuxbwkhzg2i5dljaswcroeih4dgiqq6pazcmunwt2byd725vi" in 189 189 - let%lwt mst = MemMst.create_empty store in 190 190 + let* mst = MemMst.create_empty store in 190 191 (* level 0 *) 191 192 let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fn2j" cid1 in 192 193 (* level 0 *) ··· 216 217 let root_after = mst'.root in 217 218 Alcotest.(check string) 218 219 "root cid after delete" l0root (Cid.to_string root_after) ; 219 219 - Lwt.return_unit 220 220 + Lwt.return_ok () 220 221 221 222 let test_insertion_splits_two_layers_down () = 222 223 let store = Storage.Memory_blockstore.create () in ··· 226 227 in 227 228 let l1root = "bafyreiettyludka6fpgp33stwxfuwhkzlur6chs4d2v4nkmq2j3ogpdjem" in 228 229 let l2root = "bafyreid2x5eqs4w4qxvc5jiwda4cien3gw2q6cshofxwnvv7iucrmfohpm" in 229 229 - let%lwt mst = MemMst.create_empty store in 230 230 + let* mst = MemMst.create_empty store in 230 231 (* A; level 0 *) 231 232 let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fo2j" cid1 in 232 233 (* B; level 0 *) ··· 277 278 Alcotest.(check string) 278 279 "root cid (after del F)" l1root 279 280 (Cid.to_string root_after_del_f) ; 280 280 - Lwt.return_unit 281 281 + Lwt.return_ok () 281 282 282 283 let test_new_layers_two_higher_than_existing () = 283 284 let store = Storage.Memory_blockstore.create () in ··· 288 289 let l0root = "bafyreidfcktqnfmykz2ps3dbul35pepleq7kvv526g47xahuz3rqtptmky" in 289 290 let l2root = "bafyreiavxaxdz7o7rbvr3zg2liox2yww46t7g6hkehx4i4h3lwudly7dhy" in 290 291 let l2root2 = "bafyreig4jv3vuajbsybhyvb7gggvpwh2zszwfyttjrj6qwvcsp24h6popu" in 291 291 - let%lwt mst = MemMst.create_empty store in 292 292 + let* mst = MemMst.create_empty store in 292 293 (* A; level 0 *) 293 294 let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3ft2j" cid1 in 294 295 (* C; level 0 *) ··· 333 334 let root_abc2 = mst.root in 334 335 Alcotest.(check string) 335 336 "root cid (A,B,C again)" l2root (Cid.to_string root_abc2) ; 336 336 - Lwt.return_unit 337 337 + Lwt.return_ok () 337 338 338 339 let rand_bytes n = 339 340 let b = Bytes.create n in ··· 350 351 351 352 let put_random_block store = 352 353 let cid, bytes = random_block () in 353 353 - Storage.Memory_blockstore.put_block store cid bytes >|= fun () -> cid 354 354 + Storage.Memory_blockstore.put_block store cid bytes >|= fun _ -> cid 354 355 355 356 let random_alnum len = 356 357 let allowed = "abcdefghijklmnopqrstuvwxyz0123456789" in ··· 410 411 411 412 let test_adds () = 412 413 let store = Storage.Memory_blockstore.create () in 413 413 - let%lwt mst = MemMst.create_empty store in 414 414 + let* mst = MemMst.create_empty store in 414 415 let%lwt mapping = generate_bulk_data_keys store 1000 in 415 416 let shuffled = shuffle (assoc_of_map mapping) in 416 417 let%lwt mst' = ··· 430 431 in 431 432 let%lwt total = MemMst.leaf_count mst' in 432 433 Alcotest.(check int) "leaf count after adds" 1000 total ; 433 433 - Lwt.return_unit 434 434 + Lwt.return_ok () 434 435 435 436 let test_edits () = 436 437 let store = Storage.Memory_blockstore.create () in 437 437 - let%lwt mst = MemMst.create_empty store in 438 438 + let* mst = MemMst.create_empty store in 438 439 let%lwt mapping = generate_bulk_data_keys store 1000 in 439 440 let shuffled = shuffle (assoc_of_map mapping) in 440 441 let%lwt mst = ··· 463 464 in 464 465 let%lwt total = MemMst.leaf_count edited_mst in 465 466 Alcotest.(check int) "leaf count stable after edits" 1000 total ; 466 466 - Lwt.return_unit 467 467 + Lwt.return_ok () 467 468 468 469 let test_deletes () = 469 470 let store = Storage.Memory_blockstore.create () in 470 470 - let%lwt mst = MemMst.create_empty store in 471 471 + let* mst = MemMst.create_empty store in 471 472 let%lwt mapping = generate_bulk_data_keys store 1000 in 472 473 let shuffled = shuffle (assoc_of_map mapping) in 473 474 let%lwt mst = ··· 510 511 |> Lwt.return ) 511 512 the_rest 512 513 in 513 513 - Lwt.return_unit 514 514 + Lwt.return_ok () 514 515 515 516 let test_order_independent () = 516 517 let store = Storage.Memory_blockstore.create () in 517 517 - let%lwt mst = MemMst.create_empty store in 518 518 + let* mst = MemMst.create_empty store in 518 519 let%lwt mapping = generate_bulk_data_keys store 1000 in 519 520 let shuffled = shuffle (assoc_of_map mapping) in 520 521 let%lwt mst = 521 522 Lwt_list.fold_left_s (fun t (k, v) -> MemMst.add t k v) mst shuffled 522 523 in 523 524 let%lwt all_nodes = MemMst.all_nodes mst in 524 524 - let%lwt recreated = MemMst.create_empty store in 525 525 + let* recreated = MemMst.create_empty store in 525 526 let reshuffled = shuffle (assoc_of_map mapping) in 526 527 let%lwt recreated = 527 528 Lwt_list.fold_left_s (fun t (k, v) -> MemMst.add t k v) recreated reshuffled ··· 536 537 Alcotest.(check string) 537 538 "bytes equal" (Bytes.to_string bytes1) (Bytes.to_string bytes2) ) 538 539 all_nodes all_reshuffled ; 539 539 - Lwt.return_unit 540 540 + Lwt.return_ok () 540 541 541 542 let test_save_load () = 542 543 let store = Storage.Memory_blockstore.create () in 543 543 - let%lwt mst = MemMst.create_empty store in 544 544 + let* mst = MemMst.create_empty store in 544 545 let%lwt mapping = generate_bulk_data_keys store 300 in 545 546 let shuffled = shuffle (assoc_of_map mapping) in 546 547 let%lwt mst = ··· 557 558 Alcotest.(check string) 558 559 "bytes equal" (Bytes.to_string bytes1) (Bytes.to_string bytes2) ) 559 560 orig_nodes loaded_nodes ; 560 560 - Lwt.return_unit 561 561 + Lwt.return_ok () 561 562 562 563 let test_diffs () = 563 564 let store = Storage.Memory_blockstore.create () in 564 564 - let%lwt mst0 = MemMst.create_empty store in 565 565 + let* mst0 = MemMst.create_empty store in 565 566 let%lwt mapping = generate_bulk_data_keys store 1000 in 566 567 let shuffled = shuffle (assoc_of_map mapping) in 567 568 let%lwt mst = ··· 674 675 Alcotest.(check bool) "leaf cid accounted for" true found |> Lwt.return ) 675 676 leaves 676 677 in 677 677 - Lwt.return_unit 678 678 + Lwt.return_ok () 678 679 679 680 let test_allowable_keys () = 680 681 let store = Storage.Memory_blockstore.create () in 681 681 - let%lwt mst = MemMst.create_empty store in 682 682 + let* mst = MemMst.create_empty store in 682 683 let cid1 = 683 684 Cid.of_string "bafyreie5cvv4h45feadgeuwhbcutmh6t2ceseocckahdoe6uat64zmz454" 684 685 |> Result.get_ok ··· 691 692 Alcotest.failf "expected invalid key to be rejected: %s" key ) 692 693 (function 693 694 | Invalid_argument _ -> 694 694 - Lwt.return_unit 695 695 + Lwt.return_ok () 695 696 | exn -> 696 697 Alcotest.failf "unexpected exception for %s: %s" key 697 698 (Printexc.to_string exn) ) 698 699 in 699 700 let expect_allow key = MemMst.add mst key cid1 >|= fun _ -> () in 700 700 - let%lwt () = expect_reject "" in 701 701 - let%lwt () = expect_reject "asdf" in 702 702 - let%lwt () = expect_reject "nested/collection/asdf" in 703 703 - let%lwt () = expect_reject "coll/" in 704 704 - let%lwt () = expect_reject "/rkey" in 705 705 - let%lwt () = expect_reject "coll/jalapeñoA" in 706 706 - let%lwt () = expect_reject "coll/coöperative" in 707 707 - let%lwt () = expect_reject "coll/abc💩" in 708 708 - let%lwt () = expect_reject "coll/key$" in 709 709 - let%lwt () = expect_reject "coll/key%" in 710 710 - let%lwt () = expect_reject "coll/key(" in 711 711 - let%lwt () = expect_reject "coll/key)" in 712 712 - let%lwt () = expect_reject "coll/key+" in 713 713 - let%lwt () = expect_reject "coll/key=" in 714 714 - let%lwt () = expect_reject "coll/@handle" in 715 715 - let%lwt () = expect_reject "coll/any space" in 716 716 - let%lwt () = expect_reject "coll/#extra" in 717 717 - let%lwt () = expect_reject "coll/any+space" in 718 718 - let%lwt () = expect_reject "coll/number[3]" in 719 719 - let%lwt () = expect_reject "coll/number(3)" in 720 720 - let%lwt () = expect_reject "coll/dHJ1ZQ==" in 721 721 - let%lwt () = expect_reject "coll/\"quote\"" in 701 701 + let* () = expect_reject "" in 702 702 + let* () = expect_reject "asdf" in 703 703 + let* () = expect_reject "nested/collection/asdf" in 704 704 + let* () = expect_reject "coll/" in 705 705 + let* () = expect_reject "/rkey" in 706 706 + let* () = expect_reject "coll/jalapeñoA" in 707 707 + let* () = expect_reject "coll/coöperative" in 708 708 + let* () = expect_reject "coll/abc💩" in 709 709 + let* () = expect_reject "coll/key$" in 710 710 + let* () = expect_reject "coll/key%" in 711 711 + let* () = expect_reject "coll/key(" in 712 712 + let* () = expect_reject "coll/key)" in 713 713 + let* () = expect_reject "coll/key+" in 714 714 + let* () = expect_reject "coll/key=" in 715 715 + let* () = expect_reject "coll/@handle" in 716 716 + let* () = expect_reject "coll/any space" in 717 717 + let* () = expect_reject "coll/#extra" in 718 718 + let* () = expect_reject "coll/any+space" in 719 719 + let* () = expect_reject "coll/number[3]" in 720 720 + let* () = expect_reject "coll/number(3)" in 721 721 + let* () = expect_reject "coll/dHJ1ZQ==" in 722 722 + let* () = expect_reject "coll/\"quote\"" in 722 723 let big = 723 724 "coll/" 724 725 ^ String.concat "" ··· 726 727 (Array.init 1100 (fun _ -> 727 728 String.make 1 (Char.chr (97 + Random.int 26)) ) ) ) 728 729 in 729 729 - let%lwt () = expect_reject big in 730 730 + let* () = expect_reject big in 730 731 let%lwt () = expect_allow "coll/3jui7kd54zh2y" in 731 732 let%lwt () = expect_allow "coll/self" in 732 733 let%lwt () = expect_allow "coll/example.com" in ··· 735 736 let%lwt () = expect_allow "coll/dHJ1ZQ" in 736 737 let%lwt () = expect_allow "coll/pre:fix" in 737 738 let%lwt () = expect_allow "coll/_" in 738 738 - Lwt.return_unit 739 739 + Lwt.return_ok () 739 740 740 741 let test_empty_root () = 741 742 let store = Storage.Memory_blockstore.create () in 742 742 - let%lwt mst = MemMst.create_empty store in 743 743 + let* mst = MemMst.create_empty store in 743 744 let%lwt cnt = MemMst.leaf_count mst in 744 745 Alcotest.(check int) "leaf count (empty)" 0 cnt ; 745 746 Alcotest.(check string) 746 747 "empty root cid" 747 748 "bafyreie5737gdxlw5i64vzichcalba3z2v5n6icifvx5xytvske7mr3hpm" 748 749 (Cid.to_string mst.root) ; 749 749 - Lwt.return_unit 750 750 + Lwt.return_ok () 750 751 751 752 let test_trivial_root () = 752 753 let store = Storage.Memory_blockstore.create () in ··· 754 755 cid_of_string_exn 755 756 "bafyreie5cvv4h45feadgeuwhbcutmh6t2ceseocckahdoe6uat64zmz454" 756 757 in 757 757 - let%lwt mst = MemMst.create_empty store in 758 758 + let* mst = MemMst.create_empty store in 758 759 let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fo2j" cid1 in 759 760 let%lwt cnt = MemMst.leaf_count mst in 760 761 Alcotest.(check int) "leaf count (trivial)" 1 cnt ; ··· 762 763 "trivial root cid" 763 764 "bafyreibj4lsc3aqnrvphp5xmrnfoorvru4wynt6lwidqbm2623a6tatzdu" 764 765 (Cid.to_string mst.root) ; 765 765 - Lwt.return_unit 766 766 + Lwt.return_ok () 766 767 767 768 let test_singlelayer2_root () = 768 769 let store = Storage.Memory_blockstore.create () in ··· 770 771 cid_of_string_exn 771 772 "bafyreie5cvv4h45feadgeuwhbcutmh6t2ceseocckahdoe6uat64zmz454" 772 773 in 773 773 - let%lwt mst = MemMst.create_empty store in 774 774 + let* mst = MemMst.create_empty store in 774 775 let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fx2j" cid1 in 775 776 let%lwt cnt = MemMst.leaf_count mst in 776 777 Alcotest.(check int) "leaf count (singlelayer2)" 1 cnt ; ··· 780 781 "singlelayer2 root cid" 781 782 "bafyreih7wfei65pxzhauoibu3ls7jgmkju4bspy4t2ha2qdjnzqvoy33ai" 782 783 (Cid.to_string mst.root) ; 783 783 - Lwt.return_unit 784 784 + Lwt.return_ok () 784 785 785 786 let test_simple_root () = 786 787 let store = Storage.Memory_blockstore.create () in ··· 788 789 cid_of_string_exn 789 790 "bafyreie5cvv4h45feadgeuwhbcutmh6t2ceseocckahdoe6uat64zmz454" 790 791 in 791 791 - let%lwt mst = MemMst.create_empty store in 792 792 + let* mst = MemMst.create_empty store in 792 793 (* level 0 *) 793 794 let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fp2j" cid1 in 794 795 (* level 0 *) ··· 806 807 "simple root cid" 807 808 "bafyreicmahysq4n6wfuxo522m6dpiy7z7qzym3dzs756t5n7nfdgccwq7m" 808 809 (Cid.to_string mst.root) ; 809 809 - Lwt.return_unit 810 810 + Lwt.return_ok () 810 811 811 812 let test_roundtrip () = 812 813 let mst_of_car_bytes bytes = ··· 862 863 863 864 let () = 864 865 let open Alcotest in 866 866 + let run_test test = 867 867 + match Lwt_main.run (test ()) with 868 868 + | Ok () -> 869 869 + () 870 870 + | Error e -> 871 871 + Alcotest.fail (Printexc.to_string e) 872 872 + in 865 873 run "mst" 866 874 [ ( "basic ops" 867 867 - , [ test_case "adds records" `Quick (fun () -> 868 868 - Lwt_main.run (test_adds ()) ) 869 869 - ; test_case "edits records" `Quick (fun () -> 870 870 - Lwt_main.run (test_edits ()) ) 871 871 - ; test_case "deletes records" `Quick (fun () -> 872 872 - Lwt_main.run (test_deletes ()) ) 875 875 + , [ test_case "adds records" `Quick (fun () -> run_test test_adds) 876 876 + ; test_case "edits records" `Quick (fun () -> run_test test_edits) 877 877 + ; test_case "deletes records" `Quick (fun () -> run_test test_deletes) 873 878 ; test_case "order independent" `Quick (fun () -> 874 874 - Lwt_main.run (test_order_independent ()) ) 879 879 + run_test test_order_independent ) 875 880 ; test_case "saves and loads" `Quick (fun () -> 876 876 - Lwt_main.run (test_save_load ()) ) ] ) 881 881 + run_test test_save_load ) ] ) 877 882 ; ( "mst roundtrip" 878 883 , [ test_case "car→mst→car→mst roundtrip" `Quick (fun () -> 879 884 Lwt_main.run (test_roundtrip ()) ) ] ) 880 885 ; ( "allowable keys" 881 886 , [ test_case "allowed mst keys" `Quick (fun () -> 882 882 - Lwt_main.run (test_allowable_keys ()) ) ] ) 883 883 - ; ( "diffs" 884 884 - , [test_case "diffs" `Quick (fun () -> Lwt_main.run (test_diffs ()))] ) 887 887 + run_test test_allowable_keys ) ] ) 888 888 + ; ("diffs", [test_case "diffs" `Quick (fun () -> run_test test_diffs)]) 885 889 ; ( "covering-proofs" 886 890 , [ test_case "two deep split" `Quick (fun () -> 887 887 - Lwt_main.run (test_two_deep_split ()) ) 891 891 + run_test test_two_deep_split ) 888 892 ; test_case "two deep leafless splits" `Quick (fun () -> 889 889 - Lwt_main.run (test_two_deep_leafless_splits ()) ) 893 893 + run_test test_two_deep_leafless_splits ) 890 894 ; test_case "edge with neighbour two layers down" `Quick (fun () -> 891 891 - Lwt_main.run (test_add_on_edge_with_neighbor_two_layers_down ()) ) 895 895 + run_test test_add_on_edge_with_neighbor_two_layers_down ) 892 896 ; test_case "merge and split in multi-op commit" `Quick (fun () -> 893 893 - Lwt_main.run (test_merge_and_split_in_multi_op_commit ()) ) 897 897 + run_test test_merge_and_split_in_multi_op_commit ) 894 898 ; test_case "complex multi-op commit" `Quick (fun () -> 895 895 - Lwt_main.run (test_complex_multi_op_commit ()) ) ] ) 899 899 + run_test test_complex_multi_op_commit ) ] ) 896 900 ; ( "interop edge cases" 897 901 , [ test_case "trims top of tree on delete" `Quick (fun () -> 898 898 - Lwt_main.run (test_trims_top_on_delete ()) ) 902 902 + run_test test_trims_top_on_delete ) 899 903 ; test_case "insertion splits two layers down" `Quick (fun () -> 900 900 - Lwt_main.run (test_insertion_splits_two_layers_down ()) ) 904 904 + run_test test_insertion_splits_two_layers_down ) 901 905 ; test_case "new layers two higher than existing" `Quick (fun () -> 902 902 - Lwt_main.run (test_new_layers_two_higher_than_existing ()) ) ] ) 906 906 + run_test test_new_layers_two_higher_than_existing ) ] ) 903 907 ; ( "interop known maps" 904 908 , [ test_case "computes empty tree root cid" `Quick (fun () -> 905 905 - Lwt_main.run (test_empty_root ()) ) 909 909 + run_test test_empty_root ) 906 910 ; test_case "computes trivial tree root cid" `Quick (fun () -> 907 907 - Lwt_main.run (test_trivial_root ()) ) 911 911 + run_test test_trivial_root ) 908 912 ; test_case "computes singlelayer2 tree root cid" `Quick (fun () -> 909 909 - Lwt_main.run (test_singlelayer2_root ()) ) 913 913 + run_test test_singlelayer2_root ) 910 914 ; test_case "computes simple tree root cid" `Quick (fun () -> 911 911 - Lwt_main.run (test_simple_root ()) ) ] ) ] 915 915 + run_test test_simple_root ) ] ) ]