+11 -164

mist/lib/mst.ml

reviewed

··· 233 233 234 234 val create_empty : Store.t -> (t, exn) Lwt_result.t 235 235 236 236 - val get_cid : t -> string -> Cid.t option Lwt.t 237 237 - 238 236 val of_assoc : Store.t -> (string * Cid.t) list -> t Lwt.t 239 237 240 238 val add : t -> string -> Cid.t -> t Lwt.t ··· 251 249 val leaves_of_node : node -> (string * Cid.t) list Lwt.t 252 250 253 251 val leaves_of_root : t -> (string * Cid.t) list Lwt.t 254 254 - 255 255 - val null_diff : t -> data_diff Lwt.t 256 252 257 253 val equal : t -> t -> bool Lwt.t 258 254 end ··· 789 785 Lwt_result.bind (Store.put_block blockstore cid encoded) (fun _ -> 790 786 Lwt.return_ok {blockstore; root= cid} ) 791 787 792 792 - (* returns the cid for a given key, if it exists *) 793 793 - let get_cid t key : Cid.t option Lwt.t = 794 794 - let rec get_in_node (n : node) : Cid.t option Lwt.t = 795 795 - let sorted_entries = 796 796 - List.sort 797 797 - (fun (a : entry) (b : entry) -> String.compare a.key b.key) 798 798 - n.entries 799 799 - in 800 800 - let rec scan (prev : entry option) (entries : entry list) : 801 801 - Cid.t option Lwt.t = 802 802 - match entries with 803 803 - | [] -> ( 804 804 - match prev with 805 805 - | Some p -> ( 806 806 - p.right 807 807 - >>? function Some r -> get_in_node r | None -> Lwt.return_none ) 808 808 - | None -> ( 809 809 - n.left 810 810 - >>? function Some l -> get_in_node l | None -> Lwt.return_none ) ) 811 811 - | e :: rest -> 812 812 - if key = e.key then Lwt.return_some e.value 813 813 - else if key < e.key then 814 814 - match prev with 815 815 - | Some p -> ( 816 816 - p.right 817 817 - >>? function 818 818 - | Some r -> 819 819 - get_in_node r 820 820 - | None -> 821 821 - Lwt.return_none ) 822 822 - | None -> ( 823 823 - n.left 824 824 - >>? function 825 825 - | Some l -> 826 826 - get_in_node l 827 827 - | None -> 828 828 - Lwt.return_none ) 829 829 - else scan (Some e) rest 830 830 - in 831 831 - scan None sorted_entries 832 832 - in 833 833 - match%lwt retrieve_node t t.root with 834 834 - | None -> 835 835 - Lwt.fail (Invalid_argument "root cid not found in repo store") 836 836 - | Some root -> 837 837 - get_in_node root 838 838 - 839 788 (* builds and persists a canonical mst from sorted leaves *) 840 789 let of_assoc blockstore assoc : t Lwt.t = 841 790 let open Lwt.Infix in ··· 975 924 let%lwt _ = Store.put_block blockstore cid encoded in 976 925 Lwt.return cid 977 926 978 978 - (* returns the layer a raw node belongs to *) 979 979 - let rec get_layer_raw (t : t) (raw : node_raw) : int Lwt.t = 980 980 - match (raw.l, raw.e) with 981 981 - | None, [] -> 982 982 - Lwt.return 0 983 983 - | Some left_cid, [] -> ( 984 984 - match%lwt retrieve_node_raw t left_cid with 985 985 - | Some left_raw -> 986 986 - let%lwt left_layer = get_layer_raw t left_raw in 987 987 - Lwt.return (left_layer + 1) 988 988 - | None -> 989 989 - failwith ("couldn't find node " ^ Cid.to_string left_cid) ) 990 990 - | _, e :: _ -> ( 991 991 - match e.p with 992 992 - | 0 -> 993 993 - Lwt.return (Util.leading_zeros_on_hash (Bytes.to_string e.k)) 994 994 - | _ -> 995 995 - failwith "first node entry has nonzero p value" ) 996 996 - 997 927 (* decompress entry keys from a raw node *) 998 928 let decompress_keys (raw : node_raw) : string list = 999 929 let last_key = ref "" in ··· 1049 979 let t' = {blockstore; root= result.root} in 1050 980 match%lwt retrieve_node_raw t' result.root with 1051 981 | Some raw -> 1052 1052 - let%lwt layer = get_layer_raw t' raw in 982 982 + let%lwt layer = get_node_height t' raw in 1053 983 Lwt.return (Some result.root, layer) 1054 984 | None -> 1055 985 Lwt.return (Some result.root, 0) ) ··· 1077 1007 | None -> 1078 1008 failwith ("couldn't find node " ^ Cid.to_string root_cid) 1079 1009 | Some raw -> 1080 1080 - let%lwt root_layer = get_layer_raw t raw in 1010 1010 + let%lwt root_layer = get_node_height t raw in 1081 1011 if key_layer > root_layer then 1082 1012 add_above_root t root_cid root_layer key value key_layer 1083 1013 else if key_layer = root_layer then ··· 1295 1225 let%lwt new_left_layer = 1296 1226 match new_left_raw_opt with 1297 1227 | Some r -> 1298 1298 - get_layer_raw t r 1228 1228 + get_node_height t r 1299 1229 | None -> 1300 1230 Lwt.return 0 1301 1231 in ··· 1360 1290 let%lwt new_right_layer = 1361 1291 match new_right_raw_opt with 1362 1292 | Some r -> 1363 1363 - get_layer_raw t r 1293 1293 + get_node_height t r 1364 1294 | None -> 1365 1295 Lwt.return 0 1366 1296 in ··· 1429 1359 | None -> 1430 1360 Lwt.return_none 1431 1361 | Some raw -> 1432 1432 - let%lwt root_layer = get_layer_raw t raw in 1362 1362 + let%lwt root_layer = get_node_height t raw in 1433 1363 if key_layer > root_layer then 1434 1364 (* key can't exist above root *) 1435 1365 Lwt.return_some (root_cid, root_layer) ··· 1482 1412 let%lwt result_layer = 1483 1413 match%lwt retrieve_node_raw t result.root with 1484 1414 | Some r -> 1485 1485 - get_layer_raw t r 1415 1415 + get_node_height t r 1486 1416 | None -> 1487 1417 Lwt.return 0 1488 1418 in ··· 1616 1546 | Some (new_root, _layer) -> 1617 1547 Lwt.return {t with root= new_root} 1618 1548 1619 1619 - (* produces a diff from an empty mst to the current one *) 1620 1620 - let null_diff curr : data_diff Lwt.t = 1621 1621 - let%lwt curr_nodes, _, curr_leaf_set = collect_nodes_and_leaves curr in 1622 1622 - let%lwt curr_leaves = leaves_of_root curr in 1623 1623 - let adds = List.map (fun (key, cid) : diff_add -> {key; cid}) curr_leaves in 1624 1624 - Lwt.return 1625 1625 - { adds 1626 1626 - ; updates= [] 1627 1627 - ; deletes= [] 1628 1628 - ; new_mst_blocks= curr_nodes 1629 1629 - ; new_leaf_cids= curr_leaf_set 1630 1630 - ; removed_cids= Cid.Set.empty } 1631 1631 - 1632 1549 (* checks that two msts are identical by recursively comparing their entries *) 1633 1550 let equal (t1 : t) (t2 : t) : bool Lwt.t = 1634 1551 let rec nodes_equal (n1 : node) (n2 : node) : bool Lwt.t = ··· 1700 1617 Lwt.return false 1701 1618 end 1702 1619 1703 1703 - module Differ (Prev : Intf) (Curr : Intf) = struct 1704 1704 - let diff ~(t_curr : Curr.t) ~(t_prev : Prev.t) : data_diff Lwt.t = 1705 1705 - let%lwt curr_nodes, curr_node_set, curr_leaf_set = 1706 1706 - Curr.collect_nodes_and_leaves t_curr 1707 1707 - in 1708 1708 - let%lwt _, prev_node_set, prev_leaf_set = 1709 1709 - Prev.collect_nodes_and_leaves t_prev 1710 1710 - in 1711 1711 - (* just convenient to have these functions *) 1712 1712 - let in_prev_nodes cid = Cid.Set.mem cid prev_node_set in 1713 1713 - let in_curr_nodes cid = Cid.Set.mem cid curr_node_set in 1714 1714 - let in_prev_leaves cid = Cid.Set.mem cid prev_leaf_set in 1715 1715 - let in_curr_leaves cid = Cid.Set.mem cid curr_leaf_set in 1716 1716 - (* new mst blocks are curr nodes that are not in prev *) 1717 1717 - let new_mst_blocks = 1718 1718 - List.filter (fun (cid, _) -> not (in_prev_nodes cid)) curr_nodes 1719 1719 - in 1720 1720 - (* removed cids are prev nodes not in curr plus prev leaves not in curr *) 1721 1721 - let removed_node_cids = 1722 1722 - Cid.Set.fold 1723 1723 - (fun cid acc -> 1724 1724 - if not (in_curr_nodes cid) then Cid.Set.add cid acc else acc ) 1725 1725 - prev_node_set Cid.Set.empty 1726 1726 - in 1727 1727 - let removed_leaf_cids = 1728 1728 - Cid.Set.fold 1729 1729 - (fun cid acc -> 1730 1730 - if not (in_curr_leaves cid) then Cid.Set.add cid acc else acc ) 1731 1731 - prev_leaf_set Cid.Set.empty 1732 1732 - in 1733 1733 - let removed_cids = Cid.Set.union removed_node_cids removed_leaf_cids in 1734 1734 - (* new leaf cids are curr leaves not in prev *) 1735 1735 - let new_leaf_cids = 1736 1736 - Cid.Set.fold 1737 1737 - (fun cid acc -> 1738 1738 - if not (in_prev_leaves cid) then Cid.Set.add cid acc else acc ) 1739 1739 - curr_leaf_set Cid.Set.empty 1740 1740 - in 1741 1741 - (* compute adds/updates/deletes by merging sorted leaves *) 1742 1742 - let%lwt curr_leaves = Curr.leaves_of_root t_curr in 1743 1743 - let%lwt prev_leaves = Prev.leaves_of_root t_prev in 1744 1744 - let rec merge (pl : (string * Cid.t) list) (cl : (string * Cid.t) list) 1745 1745 - (adds : diff_add list) (updates : diff_update list) 1746 1746 - (deletes : diff_delete list) = 1747 1747 - match (pl, cl) with 1748 1748 - | [], [] -> 1749 1749 - (* we prepend for speed, then reverse at the end *) 1750 1750 - (List.rev adds, List.rev updates, List.rev deletes) 1751 1751 - | [], (k, c) :: cr -> 1752 1752 - (* more curr than prev, goes in adds *) 1753 1753 - merge [] cr ({key= k; cid= c} :: adds) updates deletes 1754 1754 - | (k, c) :: pr, [] -> 1755 1755 - (* more prev than curr, goes in deletes *) 1756 1756 - merge pr [] adds updates ({key= k; cid= c} :: deletes) 1757 1757 - | (k1, c1) :: pr, (k2, c2) :: cr -> 1758 1758 - if k1 = k2 then (* if key & value are the same, keep going *) 1759 1759 - if Cid.equal c1 c2 then merge pr cr adds updates deletes 1760 1760 - else (* same key, different value; update *) 1761 1761 - merge pr cr adds ({key= k1; prev= c1; cid= c2} :: updates) deletes 1762 1762 - else if k1 < k2 then 1763 1763 - merge pr ((k2, c2) :: cr) adds updates 1764 1764 - ({key= k1; cid= c1} :: deletes) 1765 1765 - else 1766 1766 - merge ((k1, c1) :: pr) cr 1767 1767 - ({key= k2; cid= c2} :: adds) 1768 1768 - updates deletes 1769 1769 - in 1770 1770 - let adds, updates, deletes = merge prev_leaves curr_leaves [] [] [] in 1771 1771 - Lwt.return 1772 1772 - {adds; updates; deletes; new_mst_blocks; new_leaf_cids; removed_cids} 1773 1773 - end 1774 1774 - 1775 1620 module Inductive (M : Intf) = struct 1776 1621 module Cache_bs = Cache_blockstore (Memory_blockstore) 1777 1622 module Mem_mst = Make (Cache_bs) ··· 1792 1637 (String_map.bindings map) 1793 1638 in 1794 1639 (* save this now so we can read blocks from it later *) 1795 1795 - let block_map = mem_mst.blockstore.bs.blocks in 1640 1640 + let blockstore = mem_mst.blockstore in 1796 1641 (* apply inverse of operations in reverse order, 1797 1642 check that mst root matches prev_root *) 1798 1643 let%lwt inverted_mst, added_cids = ··· 1815 1660 (Cid.to_string prev_root) 1816 1661 (Cid.to_string inverted_mst.root) ) ; 1817 1662 let proof_cids = 1818 1818 - Cid.Set.union added_cids mem_mst.blockstore.reads 1663 1663 + Cid.Set.union added_cids (Cache_bs.get_reads blockstore) 1819 1664 |> Cid.Set.remove prev_root |> Cid.Set.add new_root 1820 1665 in 1821 1666 let {blocks= proof_bm; _} : Block_map.with_missing = 1822 1822 - Block_map.get_many (Cid.Set.elements proof_cids) block_map 1667 1667 + Block_map.get_many 1668 1668 + (Cid.Set.elements proof_cids) 1669 1669 + (Cache_bs.get_cache blockstore) 1823 1670 in 1824 1671 Lwt.return_ok proof_bm 1825 1672 with e -> Lwt.return_error e

+5 -9

mist/lib/storage/block_map.ml

reviewed

··· 18 18 19 19 let get_many cids m = 20 20 let blocks, missing = 21 21 - List.fold_left 22 22 - (fun (b, mis) cid -> 23 23 - match get cid m with 24 24 - | Some bytes -> 25 25 - (Cid_map.add cid bytes b, mis) 26 26 - | None -> 27 27 - (b, mis @ [cid]) ) 28 28 - (Cid_map.empty, []) cids 21 21 + List.partition_map 22 22 + (fun cid -> 23 23 + match get cid m with Some data -> Left (cid, data) | None -> Right cid ) 24 24 + cids 29 25 in 30 30 - {blocks; missing= List.rev missing} 26 26 + {blocks= Cid_map.of_list blocks; missing} 31 27 32 28 let has = Cid_map.mem 33 29

+55 -16

mist/lib/storage/cache_blockstore.ml

reviewed

··· 1 1 - type 'bs data = {mutable reads: Cid.Set.t; bs: 'bs} 1 1 + type 'bs data = {mutable reads: Cid.Set.t; mutable cache: Block_map.t; bs: 'bs} 2 2 3 3 module Make 4 4 (Bs : Blockstore.Writable) : sig 5 5 include Blockstore.Writable 6 6 7 7 val create : Bs.t -> t 8 8 + 9 9 + val get_reads : t -> Cid.Set.t 10 10 + 11 11 + val get_cache : t -> Block_map.t 8 12 end 9 13 with type t = Bs.t data = struct 10 14 type t = Bs.t data 11 15 12 12 - let create bs = {reads= Cid.Set.empty; bs} 16 16 + let create bs = {reads= Cid.Set.empty; cache= Block_map.empty; bs} 17 17 + 18 18 + let get_reads t = t.reads 19 19 + 20 20 + let get_cache t = t.cache 13 21 14 22 let get_bytes t cid = 15 15 - match%lwt Bs.get_bytes t.bs cid with 16 16 - | Some _ as res -> 23 23 + match Block_map.get cid t.cache with 24 24 + | Some _ as cached -> 17 25 t.reads <- Cid.Set.add cid t.reads ; 18 18 - Lwt.return res 19 19 - | None -> 20 20 - Lwt.return_none 26 26 + Lwt.return cached 27 27 + | None -> ( 28 28 + match%lwt Bs.get_bytes t.bs cid with 29 29 + | Some data as res -> 30 30 + t.cache <- Block_map.set cid data t.cache ; 31 31 + t.reads <- Cid.Set.add cid t.reads ; 32 32 + Lwt.return res 33 33 + | None -> 34 34 + Lwt.return_none ) 21 35 22 22 - let has t cid = Bs.has t.bs cid 36 36 + let has t cid = 37 37 + if Block_map.has cid t.cache then Lwt.return_true else Bs.has t.bs cid 23 38 24 39 let get_blocks t cids = 25 25 - let%lwt bm = Bs.get_blocks t.bs cids in 26 26 - t.reads <- 27 27 - Cid.Set.union t.reads (Cid.Set.of_list (Block_map.keys bm.blocks)) ; 28 28 - Lwt.return bm 40 40 + let {Block_map.blocks= cached; missing} = Block_map.get_many cids t.cache in 41 41 + (* mark cached as read *) 42 42 + Block_map.iter (fun cid _ -> t.reads <- Cid.Set.add cid t.reads) cached ; 43 43 + (* fetch missing from underlying store *) 44 44 + let%lwt fetched = Bs.get_blocks t.bs missing in 45 45 + (* cache and mark as read *) 46 46 + Block_map.iter 47 47 + (fun cid data -> 48 48 + t.cache <- Block_map.set cid data t.cache ; 49 49 + t.reads <- Cid.Set.add cid t.reads ) 50 50 + fetched.blocks ; 51 51 + (* combine results *) 52 52 + let blocks = 53 53 + List.fold_left 54 54 + (fun acc (cid, data) -> Block_map.set cid data acc) 55 55 + fetched.blocks (Block_map.entries cached) 56 56 + in 57 57 + Lwt.return {Block_map.blocks; missing= fetched.missing} 29 58 30 30 - let put_block t cid bytes = Bs.put_block t.bs cid bytes 59 59 + let put_block t cid bytes = 60 60 + t.cache <- Block_map.set cid bytes t.cache ; 61 61 + Bs.put_block t.bs cid bytes 31 62 32 32 - let put_many t blocks = Bs.put_many t.bs blocks 63 63 + let put_many t blocks = 64 64 + Block_map.iter 65 65 + (fun cid data -> t.cache <- Block_map.set cid data t.cache) 66 66 + blocks ; 67 67 + Bs.put_many t.bs blocks 33 68 34 34 - let delete_block t cid = Bs.delete_block t.bs cid 69 69 + let delete_block t cid = 70 70 + t.cache <- Block_map.remove cid t.cache ; 71 71 + Bs.delete_block t.bs cid 35 72 36 36 - let delete_many t cids = Bs.delete_many t.bs cids 73 73 + let delete_many t cids = 74 74 + List.iter (fun cid -> t.cache <- Block_map.remove cid t.cache) cids ; 75 75 + Bs.delete_many t.bs cids 37 76 end

+97 -47

mist/test/test_mst.ml

reviewed

··· 2 2 open Lwt.Infix 3 3 open Lwt_result.Syntax 4 4 module Mem_mst = Mst.Make (Storage.Memory_blockstore) 5 5 - module Mem_diff = Mst.Differ (Mem_mst) (Mem_mst) 6 5 module String_map = Dag_cbor.String_map 6 6 + 7 7 + module Differ (Prev : Mst.Intf) (Curr : Mst.Intf) = struct 8 8 + let diff ~(t_curr : Curr.t) ~(t_prev : Prev.t) : Mst.data_diff Lwt.t = 9 9 + let%lwt curr_nodes, curr_node_set, curr_leaf_set = 10 10 + Curr.collect_nodes_and_leaves t_curr 11 11 + in 12 12 + let%lwt _, prev_node_set, prev_leaf_set = 13 13 + Prev.collect_nodes_and_leaves t_prev 14 14 + in 15 15 + let in_prev_nodes cid = Cid.Set.mem cid prev_node_set in 16 16 + let in_curr_nodes cid = Cid.Set.mem cid curr_node_set in 17 17 + let in_prev_leaves cid = Cid.Set.mem cid prev_leaf_set in 18 18 + let in_curr_leaves cid = Cid.Set.mem cid curr_leaf_set in 19 19 + let new_mst_blocks = 20 20 + List.filter (fun (cid, _) -> not (in_prev_nodes cid)) curr_nodes 21 21 + in 22 22 + let removed_node_cids = 23 23 + Cid.Set.fold 24 24 + (fun cid acc -> 25 25 + if not (in_curr_nodes cid) then Cid.Set.add cid acc else acc ) 26 26 + prev_node_set Cid.Set.empty 27 27 + in 28 28 + let removed_leaf_cids = 29 29 + Cid.Set.fold 30 30 + (fun cid acc -> 31 31 + if not (in_curr_leaves cid) then Cid.Set.add cid acc else acc ) 32 32 + prev_leaf_set Cid.Set.empty 33 33 + in 34 34 + let removed_cids = Cid.Set.union removed_node_cids removed_leaf_cids in 35 35 + let new_leaf_cids = 36 36 + Cid.Set.fold 37 37 + (fun cid acc -> 38 38 + if not (in_prev_leaves cid) then Cid.Set.add cid acc else acc ) 39 39 + curr_leaf_set Cid.Set.empty 40 40 + in 41 41 + let%lwt curr_leaves = Curr.leaves_of_root t_curr in 42 42 + let%lwt prev_leaves = Prev.leaves_of_root t_prev in 43 43 + let rec merge (pl : (string * Cid.t) list) (cl : (string * Cid.t) list) 44 44 + (adds : Mst.diff_add list) (updates : Mst.diff_update list) 45 45 + (deletes : Mst.diff_delete list) = 46 46 + match (pl, cl) with 47 47 + | [], [] -> 48 48 + (List.rev adds, List.rev updates, List.rev deletes) 49 49 + | [], (k, c) :: cr -> 50 50 + merge [] cr ({key= k; cid= c} :: adds) updates deletes 51 51 + | (k, c) :: pr, [] -> 52 52 + merge pr [] adds updates ({key= k; cid= c} :: deletes) 53 53 + | (k1, c1) :: pr, (k2, c2) :: cr -> 54 54 + if k1 = k2 then 55 55 + if Cid.equal c1 c2 then merge pr cr adds updates deletes 56 56 + else 57 57 + merge pr cr adds ({key= k1; prev= c1; cid= c2} :: updates) deletes 58 58 + else if k1 < k2 then 59 59 + merge pr ((k2, c2) :: cr) adds updates 60 60 + ({key= k1; cid= c1} :: deletes) 61 61 + else 62 62 + merge ((k1, c1) :: pr) cr 63 63 + ({key= k2; cid= c2} :: adds) 64 64 + updates deletes 65 65 + in 66 66 + let adds, updates, deletes = merge prev_leaves curr_leaves [] [] [] in 67 67 + Lwt.return 68 68 + {Mst.adds; updates; deletes; new_mst_blocks; new_leaf_cids; removed_cids} 69 69 + end 70 70 + 71 71 + module Mem_diff = Differ (Mem_mst) (Mem_mst) 7 72 8 73 let cid_of_string_exn s = 9 74 match Cid.of_string s with Ok c -> c | Error msg -> failwith msg ··· 246 311 let%lwt mst' = 247 312 Lwt_list.fold_left_s (fun t (k, v) -> Mem_mst.add t k v) mst shuffled 248 313 in 249 249 - let%lwt () = 250 250 - Lwt_list.iter_s 251 251 - (fun (k, v) -> 252 252 - let%lwt got = Mem_mst.get_cid mst' k in 253 253 - Alcotest.(check bool) 254 254 - "added records retrievable" true 255 255 - (Option.value 256 256 - (Option.map (fun x -> Cid.equal v x) got) 257 257 - ~default:false ) 258 258 - |> Lwt.return ) 259 259 - shuffled 260 260 - in 314 314 + let%lwt result_map = Mem_mst.build_map mst' in 315 315 + List.iter 316 316 + (fun (k, v) -> 317 317 + let got = String_map.find_opt k result_map in 318 318 + Alcotest.(check bool) 319 319 + "added records retrievable" true 320 320 + (Option.value (Option.map (fun x -> Cid.equal v x) got) ~default:false) ) 321 321 + shuffled ; 261 322 let%lwt total = Mem_mst.leaf_count mst' in 262 323 Alcotest.(check int) "leaf count after adds" 1000 total ; 263 324 Lwt.return_ok () ··· 279 340 (mst, []) to_edit 280 341 in 281 342 let edited = List.rev edited in 282 282 - let%lwt () = 283 283 - Lwt_list.iter_s 284 284 - (fun (k, v) -> 285 285 - let%lwt got = Mem_mst.get_cid edited_mst k in 286 286 - Alcotest.(check bool) 287 287 - "updated records retrievable" true 288 288 - (Option.value 289 289 - (Option.map (fun x -> Cid.equal v x) got) 290 290 - ~default:false ) 291 291 - |> Lwt.return ) 292 292 - edited 293 293 - in 343 343 + let%lwt result_map = Mem_mst.build_map edited_mst in 344 344 + List.iter 345 345 + (fun (k, v) -> 346 346 + let got = String_map.find_opt k result_map in 347 347 + Alcotest.(check bool) 348 348 + "updated records retrievable" true 349 349 + (Option.value (Option.map (fun x -> Cid.equal v x) got) ~default:false) ) 350 350 + edited ; 294 351 let%lwt total = Mem_mst.leaf_count edited_mst in 295 352 Alcotest.(check int) "leaf count stable after edits" 1000 total ; 296 353 Lwt.return_ok () ··· 320 377 in 321 378 let%lwt total = Mem_mst.leaf_count deleted_mst in 322 379 Alcotest.(check int) "leaf count after deletes" 900 total ; 323 323 - let%lwt () = 324 324 - Lwt_list.iter_s 325 325 - (fun (k, _) -> 326 326 - let%lwt got = Mem_mst.get_cid deleted_mst k in 327 327 - Alcotest.(check bool) "deleted record missing" true (got = None) 328 328 - |> Lwt.return ) 329 329 - to_delete 330 330 - in 331 331 - let%lwt () = 332 332 - Lwt_list.iter_s 333 333 - (fun (k, v) -> 334 334 - let%lwt got = Mem_mst.get_cid deleted_mst k in 335 335 - Alcotest.(check bool) 336 336 - "remaining records intact" true 337 337 - (Option.value 338 338 - (Option.map (fun x -> Cid.equal v x) got) 339 339 - ~default:false ) 340 340 - |> Lwt.return ) 341 341 - the_rest 342 342 - in 380 380 + let%lwt result_map = Mem_mst.build_map deleted_mst in 381 381 + List.iter 382 382 + (fun (k, _) -> 383 383 + let got = String_map.find_opt k result_map in 384 384 + Alcotest.(check bool) "deleted record missing" true (got = None) ) 385 385 + to_delete ; 386 386 + List.iter 387 387 + (fun (k, v) -> 388 388 + let got = String_map.find_opt k result_map in 389 389 + Alcotest.(check bool) 390 390 + "remaining records intact" true 391 391 + (Option.value (Option.map (fun x -> Cid.equal v x) got) ~default:false) ) 392 392 + the_rest ; 343 393 Lwt.return_ok () 344 394 345 395 let test_order_independent () = ··· 805 855 in 806 856 let%lwt mst = Mem_mst.add mst "com.example/key1" cid1 in 807 857 let%lwt mst = Mem_mst.add mst "com.example/key1" cid2 in 808 808 - let%lwt got = Mem_mst.get_cid mst "com.example/key1" in 809 809 - ( match got with 858 858 + let%lwt result_map = Mem_mst.build_map mst in 859 859 + ( match String_map.find_opt "com.example/key1" result_map with 810 860 | Some cid -> 811 861 Alcotest.(check bool) "update replaces value" true (Cid.equal cid cid2) 812 862 | None ->

+9 -4

pegasus/lib/repository.ml

reviewed

··· 2 2 module Block_map = User_store.Block_map 3 3 module Lex = Mist.Lex 4 4 module Mst = Mist.Mst.Make (User_store) 5 5 + module Cached_store = Mist.Storage.Cache_blockstore (User_store) 6 6 + module Cached_mst = Mist.Mst.Make (Cached_store) 5 7 module Mem_mst = Mist.Mst.Make (Mist.Storage.Memory_blockstore) 6 8 module String_map = Lex.String_map 7 9 module Tid = Mist.Tid ··· 257 259 (Cid.to_string (Option.get swap_commit)) 258 260 (match t.commit with Some (c, _) -> Cid.to_string c | None -> "null") ) ; 259 261 let%lwt block_map = Lwt.map ref (get_map t) in 260 260 - let mst : Mst.t ref = ref (Mst.create t.db prev_commit.data) in 262 262 + let cached_store = Cached_store.create t.db in 263 263 + let mst : Cached_mst.t ref = 264 264 + ref (Cached_mst.create cached_store prev_commit.data) 265 265 + in 261 266 (* ops to emit, built in loop because prev_data (previous cid) is otherwise inaccessible *) 262 267 let commit_ops : commit_evt_op list ref = ref [] in 263 268 let added_leaves = ref Block_map.empty in ··· 291 296 added_leaves := Block_map.set cid block !added_leaves ; 292 297 commit_ops := 293 298 !commit_ops @ [{action= `Create; path; cid= Some cid; prev= None}] ; 294 294 - let%lwt new_mst = Mst.add !mst path cid in 299 299 + let%lwt new_mst = Cached_mst.add !mst path cid in 295 300 mst := new_mst ; 296 301 let refs = 297 302 Util.find_blob_refs value ··· 359 364 commit_ops := 360 365 !commit_ops 361 366 @ [{action= `Update; path; cid= Some new_cid; prev= old_cid}] ; 362 362 - let%lwt new_mst = Mst.add !mst path new_cid in 367 367 + let%lwt new_mst = Cached_mst.add !mst path new_cid in 363 368 mst := new_mst ; 364 369 let refs = 365 370 Util.find_blob_refs value ··· 411 416 block_map := String_map.remove path !block_map ; 412 417 commit_ops := 413 418 !commit_ops @ [{action= `Delete; path; cid= None; prev= cid}] ; 414 414 - let%lwt new_mst = Mst.delete !mst path in 419 419 + let%lwt new_mst = Cached_mst.delete !mst path in 415 420 mst := new_mst ; 416 421 Lwt.return 417 422 (Delete {type'= "com.atproto.repo.applyWrites#deleteResult"}) )