objective categorical abstract machine language personal data server
65
fork

Configure Feed

Select the types of activity you want to include in your feed.

Cache MST blocks within applyWrites

futurGH 5adf5ede f34d425d

+177 -240
+11 -164
mist/lib/mst.ml
··· 233 233 234 234 val create_empty : Store.t -> (t, exn) Lwt_result.t 235 235 236 - val get_cid : t -> string -> Cid.t option Lwt.t 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 - 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 - (* returns the cid for a given key, if it exists *) 793 - let get_cid t key : Cid.t option Lwt.t = 794 - let rec get_in_node (n : node) : Cid.t option Lwt.t = 795 - let sorted_entries = 796 - List.sort 797 - (fun (a : entry) (b : entry) -> String.compare a.key b.key) 798 - n.entries 799 - in 800 - let rec scan (prev : entry option) (entries : entry list) : 801 - Cid.t option Lwt.t = 802 - match entries with 803 - | [] -> ( 804 - match prev with 805 - | Some p -> ( 806 - p.right 807 - >>? function Some r -> get_in_node r | None -> Lwt.return_none ) 808 - | None -> ( 809 - n.left 810 - >>? function Some l -> get_in_node l | None -> Lwt.return_none ) ) 811 - | e :: rest -> 812 - if key = e.key then Lwt.return_some e.value 813 - else if key < e.key then 814 - match prev with 815 - | Some p -> ( 816 - p.right 817 - >>? function 818 - | Some r -> 819 - get_in_node r 820 - | None -> 821 - Lwt.return_none ) 822 - | None -> ( 823 - n.left 824 - >>? function 825 - | Some l -> 826 - get_in_node l 827 - | None -> 828 - Lwt.return_none ) 829 - else scan (Some e) rest 830 - in 831 - scan None sorted_entries 832 - in 833 - match%lwt retrieve_node t t.root with 834 - | None -> 835 - Lwt.fail (Invalid_argument "root cid not found in repo store") 836 - | Some root -> 837 - get_in_node root 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 - (* returns the layer a raw node belongs to *) 979 - let rec get_layer_raw (t : t) (raw : node_raw) : int Lwt.t = 980 - match (raw.l, raw.e) with 981 - | None, [] -> 982 - Lwt.return 0 983 - | Some left_cid, [] -> ( 984 - match%lwt retrieve_node_raw t left_cid with 985 - | Some left_raw -> 986 - let%lwt left_layer = get_layer_raw t left_raw in 987 - Lwt.return (left_layer + 1) 988 - | None -> 989 - failwith ("couldn't find node " ^ Cid.to_string left_cid) ) 990 - | _, e :: _ -> ( 991 - match e.p with 992 - | 0 -> 993 - Lwt.return (Util.leading_zeros_on_hash (Bytes.to_string e.k)) 994 - | _ -> 995 - failwith "first node entry has nonzero p value" ) 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 - let%lwt layer = get_layer_raw t' raw in 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 - let%lwt root_layer = get_layer_raw t raw in 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 - get_layer_raw t r 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 - get_layer_raw t r 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 - let%lwt root_layer = get_layer_raw t raw in 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 - get_layer_raw t r 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 - (* produces a diff from an empty mst to the current one *) 1620 - let null_diff curr : data_diff Lwt.t = 1621 - let%lwt curr_nodes, _, curr_leaf_set = collect_nodes_and_leaves curr in 1622 - let%lwt curr_leaves = leaves_of_root curr in 1623 - let adds = List.map (fun (key, cid) : diff_add -> {key; cid}) curr_leaves in 1624 - Lwt.return 1625 - { adds 1626 - ; updates= [] 1627 - ; deletes= [] 1628 - ; new_mst_blocks= curr_nodes 1629 - ; new_leaf_cids= curr_leaf_set 1630 - ; removed_cids= Cid.Set.empty } 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 - module Differ (Prev : Intf) (Curr : Intf) = struct 1704 - let diff ~(t_curr : Curr.t) ~(t_prev : Prev.t) : data_diff Lwt.t = 1705 - let%lwt curr_nodes, curr_node_set, curr_leaf_set = 1706 - Curr.collect_nodes_and_leaves t_curr 1707 - in 1708 - let%lwt _, prev_node_set, prev_leaf_set = 1709 - Prev.collect_nodes_and_leaves t_prev 1710 - in 1711 - (* just convenient to have these functions *) 1712 - let in_prev_nodes cid = Cid.Set.mem cid prev_node_set in 1713 - let in_curr_nodes cid = Cid.Set.mem cid curr_node_set in 1714 - let in_prev_leaves cid = Cid.Set.mem cid prev_leaf_set in 1715 - let in_curr_leaves cid = Cid.Set.mem cid curr_leaf_set in 1716 - (* new mst blocks are curr nodes that are not in prev *) 1717 - let new_mst_blocks = 1718 - List.filter (fun (cid, _) -> not (in_prev_nodes cid)) curr_nodes 1719 - in 1720 - (* removed cids are prev nodes not in curr plus prev leaves not in curr *) 1721 - let removed_node_cids = 1722 - Cid.Set.fold 1723 - (fun cid acc -> 1724 - if not (in_curr_nodes cid) then Cid.Set.add cid acc else acc ) 1725 - prev_node_set Cid.Set.empty 1726 - in 1727 - let removed_leaf_cids = 1728 - Cid.Set.fold 1729 - (fun cid acc -> 1730 - if not (in_curr_leaves cid) then Cid.Set.add cid acc else acc ) 1731 - prev_leaf_set Cid.Set.empty 1732 - in 1733 - let removed_cids = Cid.Set.union removed_node_cids removed_leaf_cids in 1734 - (* new leaf cids are curr leaves not in prev *) 1735 - let new_leaf_cids = 1736 - Cid.Set.fold 1737 - (fun cid acc -> 1738 - if not (in_prev_leaves cid) then Cid.Set.add cid acc else acc ) 1739 - curr_leaf_set Cid.Set.empty 1740 - in 1741 - (* compute adds/updates/deletes by merging sorted leaves *) 1742 - let%lwt curr_leaves = Curr.leaves_of_root t_curr in 1743 - let%lwt prev_leaves = Prev.leaves_of_root t_prev in 1744 - let rec merge (pl : (string * Cid.t) list) (cl : (string * Cid.t) list) 1745 - (adds : diff_add list) (updates : diff_update list) 1746 - (deletes : diff_delete list) = 1747 - match (pl, cl) with 1748 - | [], [] -> 1749 - (* we prepend for speed, then reverse at the end *) 1750 - (List.rev adds, List.rev updates, List.rev deletes) 1751 - | [], (k, c) :: cr -> 1752 - (* more curr than prev, goes in adds *) 1753 - merge [] cr ({key= k; cid= c} :: adds) updates deletes 1754 - | (k, c) :: pr, [] -> 1755 - (* more prev than curr, goes in deletes *) 1756 - merge pr [] adds updates ({key= k; cid= c} :: deletes) 1757 - | (k1, c1) :: pr, (k2, c2) :: cr -> 1758 - if k1 = k2 then (* if key & value are the same, keep going *) 1759 - if Cid.equal c1 c2 then merge pr cr adds updates deletes 1760 - else (* same key, different value; update *) 1761 - merge pr cr adds ({key= k1; prev= c1; cid= c2} :: updates) deletes 1762 - else if k1 < k2 then 1763 - merge pr ((k2, c2) :: cr) adds updates 1764 - ({key= k1; cid= c1} :: deletes) 1765 - else 1766 - merge ((k1, c1) :: pr) cr 1767 - ({key= k2; cid= c2} :: adds) 1768 - updates deletes 1769 - in 1770 - let adds, updates, deletes = merge prev_leaves curr_leaves [] [] [] in 1771 - Lwt.return 1772 - {adds; updates; deletes; new_mst_blocks; new_leaf_cids; removed_cids} 1773 - end 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 - let block_map = mem_mst.blockstore.bs.blocks in 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 - Cid.Set.union added_cids mem_mst.blockstore.reads 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 - Block_map.get_many (Cid.Set.elements proof_cids) block_map 1667 + Block_map.get_many 1668 + (Cid.Set.elements proof_cids) 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
··· 18 18 19 19 let get_many cids m = 20 20 let blocks, missing = 21 - List.fold_left 22 - (fun (b, mis) cid -> 23 - match get cid m with 24 - | Some bytes -> 25 - (Cid_map.add cid bytes b, mis) 26 - | None -> 27 - (b, mis @ [cid]) ) 28 - (Cid_map.empty, []) cids 21 + List.partition_map 22 + (fun cid -> 23 + match get cid m with Some data -> Left (cid, data) | None -> Right cid ) 24 + cids 29 25 in 30 - {blocks; missing= List.rev missing} 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
··· 1 - type 'bs data = {mutable reads: Cid.Set.t; bs: 'bs} 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 + 9 + val get_reads : t -> Cid.Set.t 10 + 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 - let create bs = {reads= Cid.Set.empty; bs} 16 + let create bs = {reads= Cid.Set.empty; cache= Block_map.empty; bs} 17 + 18 + let get_reads t = t.reads 19 + 20 + let get_cache t = t.cache 13 21 14 22 let get_bytes t cid = 15 - match%lwt Bs.get_bytes t.bs cid with 16 - | Some _ as res -> 23 + match Block_map.get cid t.cache with 24 + | Some _ as cached -> 17 25 t.reads <- Cid.Set.add cid t.reads ; 18 - Lwt.return res 19 - | None -> 20 - Lwt.return_none 26 + Lwt.return cached 27 + | None -> ( 28 + match%lwt Bs.get_bytes t.bs cid with 29 + | Some data as res -> 30 + t.cache <- Block_map.set cid data t.cache ; 31 + t.reads <- Cid.Set.add cid t.reads ; 32 + Lwt.return res 33 + | None -> 34 + Lwt.return_none ) 21 35 22 - let has t cid = Bs.has t.bs cid 36 + let has t cid = 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 - let%lwt bm = Bs.get_blocks t.bs cids in 26 - t.reads <- 27 - Cid.Set.union t.reads (Cid.Set.of_list (Block_map.keys bm.blocks)) ; 28 - Lwt.return bm 40 + let {Block_map.blocks= cached; missing} = Block_map.get_many cids t.cache in 41 + (* mark cached as read *) 42 + Block_map.iter (fun cid _ -> t.reads <- Cid.Set.add cid t.reads) cached ; 43 + (* fetch missing from underlying store *) 44 + let%lwt fetched = Bs.get_blocks t.bs missing in 45 + (* cache and mark as read *) 46 + Block_map.iter 47 + (fun cid data -> 48 + t.cache <- Block_map.set cid data t.cache ; 49 + t.reads <- Cid.Set.add cid t.reads ) 50 + fetched.blocks ; 51 + (* combine results *) 52 + let blocks = 53 + List.fold_left 54 + (fun acc (cid, data) -> Block_map.set cid data acc) 55 + fetched.blocks (Block_map.entries cached) 56 + in 57 + Lwt.return {Block_map.blocks; missing= fetched.missing} 29 58 30 - let put_block t cid bytes = Bs.put_block t.bs cid bytes 59 + let put_block t cid bytes = 60 + t.cache <- Block_map.set cid bytes t.cache ; 61 + Bs.put_block t.bs cid bytes 31 62 32 - let put_many t blocks = Bs.put_many t.bs blocks 63 + let put_many t blocks = 64 + Block_map.iter 65 + (fun cid data -> t.cache <- Block_map.set cid data t.cache) 66 + blocks ; 67 + Bs.put_many t.bs blocks 33 68 34 - let delete_block t cid = Bs.delete_block t.bs cid 69 + let delete_block t cid = 70 + t.cache <- Block_map.remove cid t.cache ; 71 + Bs.delete_block t.bs cid 35 72 36 - let delete_many t cids = Bs.delete_many t.bs cids 73 + let delete_many t cids = 74 + List.iter (fun cid -> t.cache <- Block_map.remove cid t.cache) cids ; 75 + Bs.delete_many t.bs cids 37 76 end
+97 -47
mist/test/test_mst.ml
··· 2 2 open Lwt.Infix 3 3 open Lwt_result.Syntax 4 4 module Mem_mst = Mst.Make (Storage.Memory_blockstore) 5 - module Mem_diff = Mst.Differ (Mem_mst) (Mem_mst) 6 5 module String_map = Dag_cbor.String_map 6 + 7 + module Differ (Prev : Mst.Intf) (Curr : Mst.Intf) = struct 8 + let diff ~(t_curr : Curr.t) ~(t_prev : Prev.t) : Mst.data_diff Lwt.t = 9 + let%lwt curr_nodes, curr_node_set, curr_leaf_set = 10 + Curr.collect_nodes_and_leaves t_curr 11 + in 12 + let%lwt _, prev_node_set, prev_leaf_set = 13 + Prev.collect_nodes_and_leaves t_prev 14 + in 15 + let in_prev_nodes cid = Cid.Set.mem cid prev_node_set in 16 + let in_curr_nodes cid = Cid.Set.mem cid curr_node_set in 17 + let in_prev_leaves cid = Cid.Set.mem cid prev_leaf_set in 18 + let in_curr_leaves cid = Cid.Set.mem cid curr_leaf_set in 19 + let new_mst_blocks = 20 + List.filter (fun (cid, _) -> not (in_prev_nodes cid)) curr_nodes 21 + in 22 + let removed_node_cids = 23 + Cid.Set.fold 24 + (fun cid acc -> 25 + if not (in_curr_nodes cid) then Cid.Set.add cid acc else acc ) 26 + prev_node_set Cid.Set.empty 27 + in 28 + let removed_leaf_cids = 29 + Cid.Set.fold 30 + (fun cid acc -> 31 + if not (in_curr_leaves cid) then Cid.Set.add cid acc else acc ) 32 + prev_leaf_set Cid.Set.empty 33 + in 34 + let removed_cids = Cid.Set.union removed_node_cids removed_leaf_cids in 35 + let new_leaf_cids = 36 + Cid.Set.fold 37 + (fun cid acc -> 38 + if not (in_prev_leaves cid) then Cid.Set.add cid acc else acc ) 39 + curr_leaf_set Cid.Set.empty 40 + in 41 + let%lwt curr_leaves = Curr.leaves_of_root t_curr in 42 + let%lwt prev_leaves = Prev.leaves_of_root t_prev in 43 + let rec merge (pl : (string * Cid.t) list) (cl : (string * Cid.t) list) 44 + (adds : Mst.diff_add list) (updates : Mst.diff_update list) 45 + (deletes : Mst.diff_delete list) = 46 + match (pl, cl) with 47 + | [], [] -> 48 + (List.rev adds, List.rev updates, List.rev deletes) 49 + | [], (k, c) :: cr -> 50 + merge [] cr ({key= k; cid= c} :: adds) updates deletes 51 + | (k, c) :: pr, [] -> 52 + merge pr [] adds updates ({key= k; cid= c} :: deletes) 53 + | (k1, c1) :: pr, (k2, c2) :: cr -> 54 + if k1 = k2 then 55 + if Cid.equal c1 c2 then merge pr cr adds updates deletes 56 + else 57 + merge pr cr adds ({key= k1; prev= c1; cid= c2} :: updates) deletes 58 + else if k1 < k2 then 59 + merge pr ((k2, c2) :: cr) adds updates 60 + ({key= k1; cid= c1} :: deletes) 61 + else 62 + merge ((k1, c1) :: pr) cr 63 + ({key= k2; cid= c2} :: adds) 64 + updates deletes 65 + in 66 + let adds, updates, deletes = merge prev_leaves curr_leaves [] [] [] in 67 + Lwt.return 68 + {Mst.adds; updates; deletes; new_mst_blocks; new_leaf_cids; removed_cids} 69 + end 70 + 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 - let%lwt () = 250 - Lwt_list.iter_s 251 - (fun (k, v) -> 252 - let%lwt got = Mem_mst.get_cid mst' k in 253 - Alcotest.(check bool) 254 - "added records retrievable" true 255 - (Option.value 256 - (Option.map (fun x -> Cid.equal v x) got) 257 - ~default:false ) 258 - |> Lwt.return ) 259 - shuffled 260 - in 314 + let%lwt result_map = Mem_mst.build_map mst' in 315 + List.iter 316 + (fun (k, v) -> 317 + let got = String_map.find_opt k result_map in 318 + Alcotest.(check bool) 319 + "added records retrievable" true 320 + (Option.value (Option.map (fun x -> Cid.equal v x) got) ~default:false) ) 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 - let%lwt () = 283 - Lwt_list.iter_s 284 - (fun (k, v) -> 285 - let%lwt got = Mem_mst.get_cid edited_mst k in 286 - Alcotest.(check bool) 287 - "updated records retrievable" true 288 - (Option.value 289 - (Option.map (fun x -> Cid.equal v x) got) 290 - ~default:false ) 291 - |> Lwt.return ) 292 - edited 293 - in 343 + let%lwt result_map = Mem_mst.build_map edited_mst in 344 + List.iter 345 + (fun (k, v) -> 346 + let got = String_map.find_opt k result_map in 347 + Alcotest.(check bool) 348 + "updated records retrievable" true 349 + (Option.value (Option.map (fun x -> Cid.equal v x) got) ~default:false) ) 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 - let%lwt () = 324 - Lwt_list.iter_s 325 - (fun (k, _) -> 326 - let%lwt got = Mem_mst.get_cid deleted_mst k in 327 - Alcotest.(check bool) "deleted record missing" true (got = None) 328 - |> Lwt.return ) 329 - to_delete 330 - in 331 - let%lwt () = 332 - Lwt_list.iter_s 333 - (fun (k, v) -> 334 - let%lwt got = Mem_mst.get_cid deleted_mst k in 335 - Alcotest.(check bool) 336 - "remaining records intact" true 337 - (Option.value 338 - (Option.map (fun x -> Cid.equal v x) got) 339 - ~default:false ) 340 - |> Lwt.return ) 341 - the_rest 342 - in 380 + let%lwt result_map = Mem_mst.build_map deleted_mst in 381 + List.iter 382 + (fun (k, _) -> 383 + let got = String_map.find_opt k result_map in 384 + Alcotest.(check bool) "deleted record missing" true (got = None) ) 385 + to_delete ; 386 + List.iter 387 + (fun (k, v) -> 388 + let got = String_map.find_opt k result_map in 389 + Alcotest.(check bool) 390 + "remaining records intact" true 391 + (Option.value (Option.map (fun x -> Cid.equal v x) got) ~default:false) ) 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 - let%lwt got = Mem_mst.get_cid mst "com.example/key1" in 809 - ( match got with 858 + let%lwt result_map = Mem_mst.build_map mst in 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
··· 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 + module Cached_store = Mist.Storage.Cache_blockstore (User_store) 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 - let mst : Mst.t ref = ref (Mst.create t.db prev_commit.data) in 262 + let cached_store = Cached_store.create t.db in 263 + let mst : Cached_mst.t ref = 264 + ref (Cached_mst.create cached_store prev_commit.data) 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 - let%lwt new_mst = Mst.add !mst path cid in 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 - let%lwt new_mst = Mst.add !mst path new_cid in 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 - let%lwt new_mst = Mst.delete !mst path in 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"}) )