+2 -3

ipld/lib/car.ml

··· 70 70 let seq = Lwt_seq.of_list [Varint.encode (Bytes.length header); header] in 71 71 Lwt_seq.append seq 72 72 (Lwt_seq.flat_map 73 73 - (fun (cid, block) -> 73 73 + (fun ((cid, block) : Cid.t * bytes) -> 74 74 Lwt_seq.of_list 75 75 - [ Varint.encode 76 76 - ((cid |> Cid.to_bytes |> Bytes.length) + Bytes.length block) 75 75 + [ Varint.encode (Bytes.length cid.bytes + Bytes.length block) 77 76 ; cid.bytes 78 77 ; block ] ) 79 78 blocks )

+2 -2

ipld/lib/cid.ml

··· 139 139 of_string str 140 140 | `String str -> 141 141 of_string str 142 142 - | _ -> 143 143 - Error "CID must be a string" 142 142 + | s -> 143 143 + Error (Printf.sprintf "invalid CID: %s" (Yojson.Safe.to_string s)) 144 144 145 145 let compare a b = String.compare (to_string a) (to_string b) 146 146

+2 -2

ipld/lib/dag_cbor.ml

··· 30 30 let rec of_yojson (json : Yojson.Safe.t) : value = 31 31 match json with 32 32 | `Assoc [("$bytes", `String s)] -> 33 33 - `Bytes (Bytes.of_string (Base64.decode_exn s)) 33 33 + `Bytes (Bytes.of_string (Base64.decode_exn ~pad:false s)) 34 34 | `Assoc [("$link", `String s)] -> 35 35 `Link (Result.get_ok (Cid.of_string s)) 36 36 | `Assoc assoc_list -> ··· 67 67 | `Boolean b -> 68 68 `Bool b 69 69 | `Integer i -> 70 70 - `Intlit (Int64.to_string i) 70 70 + `Int (Int64.to_int i) 71 71 | `Float f -> 72 72 `Float f 73 73 | `String s ->

+4 -4

ipld/test/test_dag_cbor.ml

··· 388 388 389 389 let test_yojson_roundtrip () = 390 390 let record_embed_images_0_aspect_ratio : Yojson.Safe.t = 391 391 - `Assoc [("height", `Intlit "885"); ("width", `Intlit "665")] 391 391 + `Assoc [("height", `Int 885); ("width", `Int 665)] 392 392 in 393 393 let record_embed_images_0_image : Yojson.Safe.t = 394 394 `Assoc 395 395 - [ ("height", `Intlit "885") 396 396 - ; ("width", `Intlit "665") 395 395 + [ ("height", `Int 885) 396 396 + ; ("width", `Int 665) 397 397 ; ("mimeType", `String "image/jpeg") 398 398 - ; ("size", `Intlit "645553") ] 398 398 + ; ("size", `Int 645553) ] 399 399 in 400 400 let record_embed_images_0 : Yojson.Safe.t = 401 401 `Assoc

+110 -14

mist/lib/mst.ml

··· 161 161 let decode_block_raw b : node_raw = 162 162 match Dag_cbor.decode b with 163 163 | `Map node -> 164 164 + Yojson.Safe.pretty_print Format.std_formatter 165 165 + (Dag_cbor.to_yojson (`Map node)) ; 164 166 if not (StringMap.mem "e" node) then 165 167 raise (Invalid_argument "mst node missing 'e'") ; 166 168 let l = ··· 378 380 Lwt.return path_tail ) ) 379 381 380 382 (* returns all mst entries in order for a car stream *) 381 381 - let to_blocks_seq t : (Cid.t * bytes) Lwt_seq.t = 383 383 + let to_blocks_stream t : (Cid.t * bytes) Lwt_seq.t = 382 384 let module M = struct 383 385 type stage = 384 386 (* currently walking nodes *) 385 387 | Nodes of 386 388 { next: Cid.t list (* next cids to fetch *) 387 389 ; fetched: (Cid.t * bytes) list (* fetched cids and their bytes *) 388 388 - ; leaves: Cid.Set.t (* seen leaf cids *) } 390 390 + ; leaves_seen: Cid.Set.t (* seen leaf cids for dedupe *) 391 391 + ; leaves_rev: Cid.t list (* reversed encounter order of leaves *) } 389 392 (* done walking nodes, streaming accumulated leaves *) 390 393 | Leaves of (Cid.t * bytes) list 391 394 | Done 392 395 end in 393 396 let open M in 394 397 let init_state = 395 395 - Nodes {next= [t.root]; fetched= []; leaves= Cid.Set.empty} 398 398 + Nodes 399 399 + {next= [t.root]; fetched= []; leaves_seen= Cid.Set.empty; leaves_rev= []} 396 400 in 397 401 let rec step = function 398 402 | Done -> ··· 401 405 | Nodes ({fetched= (cid, bytes) :: rest; _} as s) -> 402 406 Lwt.return_some ((cid, bytes), Nodes {s with fetched= rest}) 403 407 (* need to fetch next nodes *) 404 404 - | Nodes {next; fetched= []; leaves} -> 408 408 + | Nodes {next; fetched= []; leaves_seen; leaves_rev} -> 405 409 if List.is_empty next then ( 406 410 (* finished traversing nodes, time to switch to leaves *) 407 407 - let leaves_list = Cid.Set.to_list leaves in 411 411 + let leaves_list = List.rev leaves_rev in 408 412 let%lwt leaves_bm = Store.get_blocks t.blockstore leaves_list in 409 413 if leaves_bm.missing <> [] then failwith "missing mst leaf blocks" ; 410 410 - let leaves_nodes = Block_map.entries leaves_bm.blocks in 414 414 + let leaves_nodes = 415 415 + List.map 416 416 + (fun cid -> 417 417 + let bytes = 418 418 + Block_map.get cid leaves_bm.blocks |> Option.get 419 419 + in 420 420 + (cid, bytes) ) 421 421 + leaves_list 422 422 + in 411 423 match leaves_nodes with 412 424 | [] -> 413 425 (* with Done, we don't care about the first pair element *) ··· 419 431 (* go ahead and fetch the next nodes *) 420 432 let%lwt bm = Store.get_blocks t.blockstore next in 421 433 if bm.missing <> [] then failwith "missing mst nodes" ; 422 422 - let fetched, next', leaves' = 434 434 + let fetched, next', leaves_seen', leaves_rev' = 423 435 List.fold_left 424 424 - (fun (acc, nxt, lvs) cid -> 436 436 + (fun (acc, nxt, seen, rev) cid -> 425 437 let bytes = 426 438 (* we should be safe to do this since we just got the cids from the blockmap *) 427 439 Block_map.get cid bm.blocks |> Option.get ··· 440 452 nxt ) 441 453 node.e 442 454 in 443 443 - let lvs' = 444 444 - (* add each entry in this node to the list of seen leaves *) 445 445 - List.fold_left (fun s e -> Cid.Set.add e.v s) lvs node.e 455 455 + let seen', rev' = 456 456 + (* add each entry in this node to the seen set and record encounter order *) 457 457 + List.fold_left 458 458 + (fun (s, r) e -> 459 459 + if Cid.Set.mem e.v s then (s, r) 460 460 + else (Cid.Set.add e.v s, e.v :: r) ) 461 461 + (seen, rev) node.e 446 462 in 447 463 (* prepending is O(1) per prepend + one O(n) to reverse, vs. O(n) per append = O(n^2) total *) 448 448 - ((cid, bytes) :: acc, nxt', lvs') ) 449 449 - ([], [], leaves) next 464 464 + ((cid, bytes) :: acc, nxt', seen', rev') ) 465 465 + ([], [], leaves_seen, leaves_rev) 466 466 + next 450 467 in 451 468 step 452 469 (Nodes 453 470 { next= List.rev next' 454 471 ; fetched= List.rev fetched 455 455 - ; leaves= leaves' } ) 472 472 + ; leaves_seen= leaves_seen' 473 473 + ; leaves_rev= leaves_rev' } ) 456 474 (* if we're onto yielding leaves, do that *) 457 475 | Leaves ((cid, bytes) :: rest) -> 458 476 let next = if rest = [] then Done else Leaves rest in ··· 462 480 Lwt.return_some (Obj.magic (), Done) 463 481 in 464 482 Lwt_seq.unfold_lwt step init_state 483 483 + 484 484 + (* returns a car v1 formatted stream containing the mst *) 485 485 + let to_car_stream t : bytes Lwt_seq.t = 486 486 + t |> to_blocks_stream |> Car.blocks_to_stream (Some t.root) 487 487 + 488 488 + (* returns a car archive containing the mst *) 489 489 + let to_car t : bytes Lwt.t = 490 490 + t |> to_blocks_stream |> Car.blocks_to_car (Some t.root) 465 491 466 492 (* returns all mst nodes needed to prove the value of a given key *) 467 493 let rec proof_for_key t root key : Block_map.t Lwt.t = ··· 743 769 let adds, updates, deletes = merge prev_leaves curr_leaves [] [] [] in 744 770 Lwt.return 745 771 {adds; updates; deletes; new_mst_blocks; new_leaf_cids; removed_cids} 772 772 + 773 773 + (* checks that two msts are identical by recursively comparing their entries *) 774 774 + let equal (t1 : t) (t2 : t) : bool Lwt.t = 775 775 + let rec nodes_equal (n1 : node) (n2 : node) : bool Lwt.t = 776 776 + if n1.layer <> n2.layer then Lwt.return false 777 777 + else if List.length n1.entries <> List.length n2.entries then 778 778 + Lwt.return false 779 779 + else 780 780 + let%lwt left_equal = 781 781 + n1.left 782 782 + >>? function 783 783 + | Some l1 -> ( 784 784 + n2.left 785 785 + >>? function 786 786 + | Some l2 -> 787 787 + nodes_equal l1 l2 788 788 + | None -> 789 789 + Lwt.return false ) 790 790 + | None -> ( 791 791 + n2.left 792 792 + >>? function 793 793 + | Some _ -> 794 794 + Lwt.return false 795 795 + | None -> 796 796 + Lwt.return true ) 797 797 + in 798 798 + if not left_equal then Lwt.return false 799 799 + else 800 800 + let rec entries_equal (e1s : entry list) (e2s : entry list) = 801 801 + match (e1s, e2s) with 802 802 + | [], [] -> 803 803 + Lwt.return true 804 804 + | e1 :: rest1, e2 :: rest2 -> 805 805 + if 806 806 + e1.layer <> e2.layer || e1.key <> e2.key 807 807 + || not (Cid.equal e1.value e2.value) 808 808 + then Lwt.return false 809 809 + else 810 810 + let%lwt right_equal = 811 811 + e1.right 812 812 + >>? function 813 813 + | Some r1 -> ( 814 814 + e2.right 815 815 + >>? function 816 816 + | Some r2 -> 817 817 + nodes_equal r1 r2 818 818 + | None -> 819 819 + Lwt.return false ) 820 820 + | None -> ( 821 821 + e2.right 822 822 + >>? function 823 823 + | Some _ -> 824 824 + Lwt.return false 825 825 + | None -> 826 826 + Lwt.return true ) 827 827 + in 828 828 + if not right_equal then Lwt.return false 829 829 + else entries_equal rest1 rest2 830 830 + | _ -> 831 831 + Lwt.return false 832 832 + in 833 833 + entries_equal n1.entries n2.entries 834 834 + in 835 835 + match%lwt Lwt.all [retrieve_node t1 t1.root; retrieve_node t2 t2.root] with 836 836 + | [Some r1; Some r2] -> 837 837 + nodes_equal r1 r2 838 838 + | [None; None] -> 839 839 + Lwt.return true 840 840 + | _ -> 841 841 + Lwt.return false 746 842 end

+48

mist/lib/repository.ml

··· 1 1 + type commit = 2 2 + { did: string 3 3 + ; version: int (* always 3 *) 4 4 + ; data: Cid.t 5 5 + ; rev: Tid.t 6 6 + ; prev: Cid.t option } 7 7 + 8 8 + type signed_commit = 9 9 + { did: string 10 10 + ; version: int (* always 3 *) 11 11 + ; data: Cid.t [@of_yojson Cid.of_yojson] [@to_yojson Cid.to_yojson] 12 12 + ; rev: Tid.t 13 13 + ; prev: Cid.t option 14 14 + [@of_yojson 15 15 + function 16 16 + | `Assoc link -> 17 17 + link |> List.assoc "$link" |> Cid.of_yojson 18 18 + |> Result.map (fun cid -> Some cid) 19 19 + | `Null -> 20 20 + Ok None 21 21 + | _ -> 22 22 + Error "commit prev not a valid cid"] 23 23 + [@to_yojson function Some cid -> Cid.to_yojson cid | None -> `Null] 24 24 + ; signature: bytes 25 25 + [@key "sig"] 26 26 + [@of_yojson 27 27 + fun x -> 28 28 + match Dag_cbor.of_yojson x with 29 29 + | `Bytes b -> 30 30 + Ok b 31 31 + | _ -> 32 32 + Error "commit sig not a valid bytes value"] 33 33 + [@to_yojson fun x -> Dag_cbor.to_yojson (`Bytes x)] } 34 34 + [@@deriving yojson] 35 35 + 36 36 + type signing_key = P256 of bytes | K256 of bytes 37 37 + 38 38 + module Make (Store : Storage.Writable_blockstore) = struct 39 39 + type store = Store.t 40 40 + 41 41 + let read_commit store cid : (signed_commit, string) Lwt_result.t = 42 42 + let%lwt bytes = Store.get_bytes store cid in 43 43 + match bytes with 44 44 + | Some b -> 45 45 + b |> Dag_cbor.decode_to_yojson |> signed_commit_of_yojson |> Lwt.return 46 46 + | None -> 47 47 + Lwt.return_error ("commit not found in blockstore: " ^ Cid.to_string cid) 48 48 + end

+6 -2

mist/test/dune

··· 1 1 (tests 2 2 - (names test_tid test_util) 2 2 + (names test_mst test_tid test_util) 3 3 (package mist) 4 4 - (libraries mist alcotest)) 4 4 + (libraries ipld mist lwt lwt_ppx alcotest) 5 5 + (deps 6 6 + (file %{project_root}/mist/test/sample.car)) 7 7 + (preprocess 8 8 + (pps lwt_ppx)))

mist/test/sample.car

This is a binary file and will not be displayed.

+51

mist/test/test_mst.ml

··· 1 1 + open Mist 2 2 + module MemMst = Mst.Make (Storage.Memory_blockstore) 3 3 + module MemRepo = Repository.Make (Storage.Memory_blockstore) 4 4 + 5 5 + let test_roundtrip () = 6 6 + let open Lwt.Infix in 7 7 + let mst_of_car_bytes bytes = 8 8 + let%lwt roots, blocks = Car.read_car_stream (Lwt_seq.of_list [bytes]) in 9 9 + let root = 10 10 + match roots with 11 11 + | [root] -> 12 12 + root 13 13 + | _ -> 14 14 + failwith "expected exactly one root in car stream" 15 15 + in 16 16 + let%lwt bm = 17 17 + Lwt_seq.fold_left 18 18 + (fun acc (cid, bytes) -> Storage.Block_map.set cid bytes acc) 19 19 + Storage.Block_map.empty blocks 20 20 + in 21 21 + let store = Storage.Memory_blockstore.create ~blocks:bm () in 22 22 + let%lwt commit = 23 23 + MemRepo.read_commit store root 24 24 + >|= function Ok commit -> commit | Error msg -> failwith msg 25 25 + in 26 26 + let mst = MemMst.create store commit.data in 27 27 + Lwt.return (commit, mst) 28 28 + in 29 29 + let%lwt ic = Lwt_io.open_file ~mode:Lwt_io.input "sample.car" in 30 30 + let%lwt car = Lwt_io.read ic >|= Bytes.of_string in 31 31 + let%lwt () = Lwt_io.close ic in 32 32 + let%lwt commit, mst = mst_of_car_bytes car in 33 33 + let mst_stream = MemMst.to_blocks_stream mst in 34 34 + let commit_bytes = 35 35 + Dag_cbor.encode_yojson (Repository.signed_commit_to_yojson commit) 36 36 + in 37 37 + let commit_cid = Cid.create Dcbor commit_bytes in 38 38 + let%lwt car' = 39 39 + Car.blocks_to_car (Some commit_cid) 40 40 + (Lwt_seq.append (Lwt_seq.of_list [(commit_cid, commit_bytes)]) mst_stream) 41 41 + in 42 42 + let%lwt _, mst' = mst_of_car_bytes car' in 43 43 + let%lwt eq = MemMst.equal mst mst' in 44 44 + Lwt.return (Alcotest.(check bool) "mst roundtrip" true eq) 45 45 + 46 46 + let () = 47 47 + let open Alcotest in 48 48 + run "mst" 49 49 + [ ( "mst roundtrip" 50 50 + , [ test_case "car→mst→car→mst roundtrip" `Quick (fun () -> 51 51 + Lwt_main.run (test_roundtrip ()) ) ] ) ]

+1 -1

mist/test/test_tid.ml

··· 2 2 3 3 let test_create () = 4 4 Alcotest.(check string) 5 5 - "tid" "3kztsgrxhzsje" 5 5 + "tid" "3kztsgrxiyxje" 6 6 (Tid.of_timestamp_ms 1723819911723L ~clockid:490) 7 7 8 8 let test_invalid_create () =