objective categorical abstract machine language personal data server
65
fork

Configure Feed

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

Fix inductive proof generation

futurGH a0688f82 d10ae26a

+306 -253
+76 -21
mist/lib/mst.ml
··· 1 1 open Storage 2 - module StringMap = Dag_cbor.StringMap 2 + module String_map = Dag_cbor.StringMap 3 3 4 4 type node_raw = 5 5 { (* link to lower level left subtree with all keys sorting before this node *) ··· 19 19 20 20 let encode_entry_raw entry : Dag_cbor.value = 21 21 `Map 22 - (StringMap.of_list 22 + (String_map.of_list 23 23 [ ("p", `Integer (Int64.of_int entry.p)) 24 24 ; ("k", `Bytes entry.k) 25 25 ; ("v", `Link entry.v) ··· 27 27 28 28 let encode_node_raw node : Dag_cbor.value = 29 29 `Map 30 - (StringMap.of_list 30 + (String_map.of_list 31 31 [ ("l", match node.l with Some l -> `Link l | None -> `Null) 32 32 ; ("e", `Array (Array.of_list (List.map encode_entry_raw node.e))) ] ) 33 33 ··· 64 64 f result 65 65 66 66 module type Intf = sig 67 - type bs 67 + module Store : Writable_blockstore 68 68 69 - type t = {blockstore: bs; root: Cid.t} 69 + type t = {blockstore: Store.t; root: Cid.t} 70 70 71 - val create : bs -> Cid.t -> t 71 + val create : Store.t -> Cid.t -> t 72 72 73 73 val retrieve_node_raw : t -> Cid.t -> node_raw option Lwt.t 74 74 ··· 80 80 81 81 val traverse : t -> (string -> Cid.t -> unit) -> unit Lwt.t 82 82 83 - val build_map : t -> Cid.t StringMap.t Lwt.t 83 + val build_map : t -> Cid.t String_map.t Lwt.t 84 84 85 85 val to_blocks_stream : t -> (Cid.t * bytes) Lwt_seq.t 86 86 ··· 96 96 97 97 val all_nodes : t -> (Cid.t * bytes) list Lwt.t 98 98 99 - val create_empty : bs -> (t, exn) Lwt_result.t 99 + val create_empty : Store.t -> (t, exn) Lwt_result.t 100 100 101 101 val get_cid : t -> string -> Cid.t option Lwt.t 102 102 103 - val of_assoc : bs -> (string * Cid.t) list -> t Lwt.t 103 + val of_assoc : Store.t -> (string * Cid.t) list -> t Lwt.t 104 104 105 105 val add : t -> string -> Cid.t -> t Lwt.t 106 106 ··· 118 118 val equal : t -> t -> bool Lwt.t 119 119 end 120 120 121 - module Make (Store : Writable_blockstore) : Intf with type bs = Store.t = struct 121 + module Make (Store : Writable_blockstore) : Intf with module Store = Store = 122 + struct 123 + module Store = Store 124 + 122 125 type bs = Store.t 123 126 124 127 type t = {blockstore: bs; root: Cid.t} ··· 129 132 let decode_block_raw b : node_raw = 130 133 match Dag_cbor.decode b with 131 134 | `Map node -> 132 - if not (StringMap.mem "e" node) then 135 + if not (String_map.mem "e" node) then 133 136 raise (Invalid_argument "mst node missing 'e'") ; 134 137 let l = 135 - if StringMap.mem "l" node then 136 - match StringMap.find "l" node with `Link l -> Some l | _ -> None 138 + if String_map.mem "l" node then 139 + match String_map.find "l" node with `Link l -> Some l | _ -> None 137 140 else None 138 141 in 139 142 let e_array = 140 - match StringMap.find "e" node with `Array e -> e | _ -> [||] 143 + match String_map.find "e" node with `Array e -> e | _ -> [||] 141 144 in 142 145 let e = 143 146 Array.to_list ··· 146 149 match entry with 147 150 | `Map entry -> 148 151 { p= 149 - ( entry |> StringMap.find "p" 152 + ( entry |> String_map.find "p" 150 153 |> function 151 154 | `Integer p -> 152 155 Int64.to_int p 153 156 | _ -> 154 157 raise (Invalid_argument "mst entry missing 'p'") ) 155 158 ; k= 156 - ( entry |> StringMap.find "k" 159 + ( entry |> String_map.find "k" 157 160 |> function 158 161 | `Bytes k -> 159 162 k 160 163 | _ -> 161 164 raise (Invalid_argument "mst entry missing 'k'") ) 162 165 ; v= 163 - ( entry |> StringMap.find "v" 166 + ( entry |> String_map.find "v" 164 167 |> function 165 168 | `Link v -> 166 169 v 167 170 | _ -> 168 171 raise (Invalid_argument "mst entry missing 'v'") ) 169 172 ; t= 170 - ( entry |> StringMap.find "t" 173 + ( entry |> String_map.find "t" 171 174 |> function `Link t -> Some t | _ -> None ) } 172 175 | _ -> 173 176 raise (Invalid_argument "non-map mst entry") ) ··· 266 269 failwith "root cid not found in repo store" 267 270 268 271 (* returns a map of key -> cid *) 269 - let build_map t : Cid.t StringMap.t Lwt.t = 270 - let map = ref StringMap.empty in 272 + let build_map t : Cid.t String_map.t Lwt.t = 273 + let map = ref String_map.empty in 271 274 let%lwt () = 272 - traverse t (fun path cid -> map := StringMap.add path cid !map) 275 + traverse t (fun path cid -> map := String_map.add path cid !map) 273 276 in 274 277 Lwt.return !map 275 278 ··· 1103 1106 Lwt.return 1104 1107 {adds; updates; deletes; new_mst_blocks; new_leaf_cids; removed_cids} 1105 1108 end 1109 + 1110 + module Inductive (M : Intf) = struct 1111 + module Mem_mst = Make (Memory_blockstore) 1112 + 1113 + type diff = 1114 + | Add of {key: string; cid: Cid.t} 1115 + | Update of {key: string; prev: Cid.t option; cid: Cid.t} 1116 + | Delete of {key: string; prev: Cid.t} 1117 + 1118 + (* given an mst diff, returns all new blocks as well as inductive proof blocks *) 1119 + let generate_proof (curr : M.t) (diff : diff list) (prev_root : Cid.t) : 1120 + ((Cid.t * bytes) list, exn) Lwt_result.t = 1121 + try%lwt 1122 + let%lwt map = M.build_map curr in 1123 + let%lwt mem_mst = 1124 + Mem_mst.of_assoc (Memory_blockstore.create ()) (String_map.bindings map) 1125 + in 1126 + (* track all accessed cids relevant to inductive proof *) 1127 + let accessed_cids = ref Cid.Set.empty in 1128 + (* apply inverse of operations in reverse order *) 1129 + let%lwt new_mst, added_cids = 1130 + Lwt_list.fold_right_s 1131 + (fun (diff : diff) (mst, added_cids) -> 1132 + match diff with 1133 + | Delete {key; prev} | Update {key; prev= Some prev; _} -> 1134 + accessed_cids := Cid.Set.add prev !accessed_cids ; 1135 + let%lwt mst = Mem_mst.add mst key prev in 1136 + Lwt.return (mst, Cid.Set.remove prev added_cids) 1137 + | Add {key; cid} | Update {key; prev= None; cid} -> 1138 + accessed_cids := Cid.Set.add cid !accessed_cids ; 1139 + let%lwt mst = Mem_mst.delete mst key in 1140 + Lwt.return (mst, Cid.Set.add cid added_cids) ) 1141 + diff (mem_mst, Cid.Set.empty) 1142 + in 1143 + if not (Cid.equal new_mst.root prev_root) then 1144 + failwith 1145 + (Printf.sprintf 1146 + "inductive proof produced invalid previous cid: expected %s, got \ 1147 + %s" 1148 + (Cid.to_string prev_root) 1149 + (Cid.to_string new_mst.root) ) ; 1150 + let proof_cids = 1151 + Cid.Set.union added_cids !accessed_cids 1152 + |> Cid.Set.remove prev_root |> Cid.Set.add new_mst.root 1153 + in 1154 + let%lwt {blocks= proof_bm; _} = 1155 + Memory_blockstore.get_blocks mem_mst.blockstore 1156 + (Cid.Set.elements proof_cids) 1157 + in 1158 + Lwt.return_ok (Block_map.entries proof_bm) 1159 + with e -> Lwt.return_error e 1160 + end
+199 -194
mist/test/test_mst.ml
··· 1 1 open Mist 2 2 open Lwt.Infix 3 3 open Lwt_result.Syntax 4 - module MemMst = Mst.Make (Storage.Memory_blockstore) 5 - module MemDiff = Mst.Differ (MemMst) (MemMst) 6 - module StringMap = Dag_cbor.StringMap 4 + module Mem_mst = Mst.Make (Storage.Memory_blockstore) 5 + module Mem_diff = Mst.Differ (Mem_mst) (Mem_mst) 6 + module String_map = Dag_cbor.StringMap 7 7 8 8 let cid_of_string_exn s = 9 9 match Cid.of_string s with Ok c -> c | Error msg -> failwith msg ··· 46 46 cid_of_string_exn 47 47 "bafyreie5cvv4h45feadgeuwhbcutmh6t2ceseocckahdoe6uat64zmz454" 48 48 49 - let mst_of_proof root proof : MemMst.t = 49 + let mst_of_proof root proof : Mem_mst.t = 50 50 let store = Storage.Memory_blockstore.create ~blocks:proof () in 51 - MemMst.create store root 51 + Mem_mst.create store root 52 52 53 53 let test_two_deep_split () = 54 54 let store = Storage.Memory_blockstore.create () in 55 - let* mst = MemMst.create_empty store in 56 - let%lwt mst = MemMst.add mst Keys.a0 leaf_cid in 57 - let%lwt mst = MemMst.add mst Keys.b1 leaf_cid in 58 - let%lwt mst = MemMst.add mst Keys.c0 leaf_cid in 59 - let%lwt mst = MemMst.add mst Keys.e0 leaf_cid in 60 - let%lwt mst = MemMst.add mst Keys.f1 leaf_cid in 61 - let%lwt mst = MemMst.add mst Keys.g0 leaf_cid in 62 - let%lwt mst = MemMst.add mst Keys.d2 leaf_cid in 63 - let%lwt proof = MemMst.get_covering_proof mst Keys.d2 in 55 + let* mst = Mem_mst.create_empty store in 56 + let%lwt mst = Mem_mst.add mst Keys.a0 leaf_cid in 57 + let%lwt mst = Mem_mst.add mst Keys.b1 leaf_cid in 58 + let%lwt mst = Mem_mst.add mst Keys.c0 leaf_cid in 59 + let%lwt mst = Mem_mst.add mst Keys.e0 leaf_cid in 60 + let%lwt mst = Mem_mst.add mst Keys.f1 leaf_cid in 61 + let%lwt mst = Mem_mst.add mst Keys.g0 leaf_cid in 62 + let%lwt mst = Mem_mst.add mst Keys.d2 leaf_cid in 63 + let%lwt proof = Mem_mst.get_covering_proof mst Keys.d2 in 64 64 let proof_mst = mst_of_proof mst.root proof in 65 - let%lwt got = MemMst.get_cid proof_mst Keys.d2 in 65 + let%lwt got = Mem_mst.get_cid proof_mst Keys.d2 in 66 66 Alcotest.(check bool) 67 67 "covering proof proves d2" true 68 68 (Option.value ··· 72 72 73 73 let test_two_deep_leafless_splits () = 74 74 let store = Storage.Memory_blockstore.create () in 75 - let* mst = MemMst.create_empty store in 76 - let%lwt mst = MemMst.add mst Keys.a0 leaf_cid in 77 - let%lwt mst = MemMst.add mst Keys.b0 leaf_cid in 78 - let%lwt mst = MemMst.add mst Keys.d0 leaf_cid in 79 - let%lwt mst = MemMst.add mst Keys.e0 leaf_cid in 80 - let%lwt mst = MemMst.add mst Keys.c2 leaf_cid in 81 - let%lwt proof = MemMst.get_covering_proof mst Keys.c2 in 75 + let* mst = Mem_mst.create_empty store in 76 + let%lwt mst = Mem_mst.add mst Keys.a0 leaf_cid in 77 + let%lwt mst = Mem_mst.add mst Keys.b0 leaf_cid in 78 + let%lwt mst = Mem_mst.add mst Keys.d0 leaf_cid in 79 + let%lwt mst = Mem_mst.add mst Keys.e0 leaf_cid in 80 + let%lwt mst = Mem_mst.add mst Keys.c2 leaf_cid in 81 + let%lwt proof = Mem_mst.get_covering_proof mst Keys.c2 in 82 82 let proof_mst = mst_of_proof mst.root proof in 83 - let%lwt got = MemMst.get_cid proof_mst Keys.c2 in 83 + let%lwt got = Mem_mst.get_cid proof_mst Keys.c2 in 84 84 Alcotest.(check bool) 85 85 "covering proof proves c2" true 86 86 (Option.value ··· 90 90 91 91 let test_add_on_edge_with_neighbor_two_layers_down () = 92 92 let store = Storage.Memory_blockstore.create () in 93 - let* mst = MemMst.create_empty store in 94 - let%lwt mst = MemMst.add mst Keys.a0 leaf_cid in 95 - let%lwt mst = MemMst.add mst Keys.b2 leaf_cid in 96 - let%lwt mst = MemMst.add mst Keys.c0 leaf_cid in 97 - let%lwt mst = MemMst.add mst Keys.d2 leaf_cid in 98 - let%lwt proof = MemMst.get_covering_proof mst Keys.d2 in 93 + let* mst = Mem_mst.create_empty store in 94 + let%lwt mst = Mem_mst.add mst Keys.a0 leaf_cid in 95 + let%lwt mst = Mem_mst.add mst Keys.b2 leaf_cid in 96 + let%lwt mst = Mem_mst.add mst Keys.c0 leaf_cid in 97 + let%lwt mst = Mem_mst.add mst Keys.d2 leaf_cid in 98 + let%lwt proof = Mem_mst.get_covering_proof mst Keys.d2 in 99 99 let proof_mst = mst_of_proof mst.root proof in 100 - let%lwt got = MemMst.get_cid proof_mst Keys.d2 in 100 + let%lwt got = Mem_mst.get_cid proof_mst Keys.d2 in 101 101 Alcotest.(check bool) 102 102 "covering proof proves d2" true 103 103 (Option.value ··· 107 107 108 108 let test_merge_and_split_in_multi_op_commit () = 109 109 let store = Storage.Memory_blockstore.create () in 110 - let* mst = MemMst.create_empty store in 111 - let%lwt mst = MemMst.add mst Keys.b0 leaf_cid in 112 - let%lwt mst = MemMst.add mst Keys.c2 leaf_cid in 113 - let%lwt mst = MemMst.add mst Keys.d0 leaf_cid in 114 - let%lwt mst = MemMst.add mst Keys.e2 leaf_cid in 115 - let%lwt mst = MemMst.add mst Keys.f0 leaf_cid in 116 - let%lwt mst = MemMst.add mst Keys.h0 leaf_cid in 117 - let%lwt mst = MemMst.delete mst Keys.b2 in 118 - let%lwt mst = MemMst.delete mst Keys.d2 in 119 - let%lwt mst = MemMst.add mst Keys.c2 leaf_cid in 110 + let* mst = Mem_mst.create_empty store in 111 + let%lwt mst = Mem_mst.add mst Keys.b0 leaf_cid in 112 + let%lwt mst = Mem_mst.add mst Keys.c2 leaf_cid in 113 + let%lwt mst = Mem_mst.add mst Keys.d0 leaf_cid in 114 + let%lwt mst = Mem_mst.add mst Keys.e2 leaf_cid in 115 + let%lwt mst = Mem_mst.add mst Keys.f0 leaf_cid in 116 + let%lwt mst = Mem_mst.add mst Keys.h0 leaf_cid in 117 + let%lwt mst = Mem_mst.delete mst Keys.b2 in 118 + let%lwt mst = Mem_mst.delete mst Keys.d2 in 119 + let%lwt mst = Mem_mst.add mst Keys.c2 leaf_cid in 120 120 let%lwt proofs = 121 121 Lwt.all 122 - [ MemMst.get_covering_proof mst Keys.b2 123 - ; MemMst.get_covering_proof mst Keys.d2 124 - ; MemMst.get_covering_proof mst Keys.c2 ] 122 + [ Mem_mst.get_covering_proof mst Keys.b2 123 + ; Mem_mst.get_covering_proof mst Keys.d2 124 + ; Mem_mst.get_covering_proof mst Keys.c2 ] 125 125 in 126 126 let proof = 127 127 List.fold_left Storage.Block_map.merge Storage.Block_map.empty proofs 128 128 in 129 129 let proof_mst = mst_of_proof mst.root proof in 130 - let%lwt got_c2 = MemMst.get_cid proof_mst Keys.c2 in 130 + let%lwt got_c2 = Mem_mst.get_cid proof_mst Keys.c2 in 131 131 Alcotest.(check bool) 132 132 "covering proof proves c2" true 133 133 (Option.value 134 134 (Option.map (fun x -> Cid.equal leaf_cid x) got_c2) 135 135 ~default:false ) ; 136 - let%lwt got_b2 = MemMst.get_cid proof_mst Keys.b2 in 136 + let%lwt got_b2 = Mem_mst.get_cid proof_mst Keys.b2 in 137 137 Alcotest.(check bool) 138 138 "covering proof proves non-membership of b2" true (got_b2 = None) ; 139 - let%lwt got_d2 = MemMst.get_cid proof_mst Keys.d2 in 139 + let%lwt got_d2 = Mem_mst.get_cid proof_mst Keys.d2 in 140 140 Alcotest.(check bool) 141 141 "covering proof proves non-membership of d2" true (got_d2 = None) ; 142 142 Lwt.return_ok () 143 143 144 144 let test_complex_multi_op_commit () = 145 145 let store = Storage.Memory_blockstore.create () in 146 - let* mst = MemMst.create_empty store in 147 - let%lwt mst = MemMst.add mst Keys.b0 leaf_cid in 148 - let%lwt mst = MemMst.add mst Keys.c2 leaf_cid in 149 - let%lwt mst = MemMst.add mst Keys.d0 leaf_cid in 150 - let%lwt mst = MemMst.add mst Keys.e2 leaf_cid in 151 - let%lwt mst = MemMst.add mst Keys.f0 leaf_cid in 152 - let%lwt mst = MemMst.add mst Keys.h0 leaf_cid in 153 - let%lwt mst = MemMst.add mst Keys.a2 leaf_cid in 154 - let%lwt mst = MemMst.add mst Keys.g2 leaf_cid in 155 - let%lwt mst = MemMst.delete mst Keys.c2 in 146 + let* mst = Mem_mst.create_empty store in 147 + let%lwt mst = Mem_mst.add mst Keys.b0 leaf_cid in 148 + let%lwt mst = Mem_mst.add mst Keys.c2 leaf_cid in 149 + let%lwt mst = Mem_mst.add mst Keys.d0 leaf_cid in 150 + let%lwt mst = Mem_mst.add mst Keys.e2 leaf_cid in 151 + let%lwt mst = Mem_mst.add mst Keys.f0 leaf_cid in 152 + let%lwt mst = Mem_mst.add mst Keys.h0 leaf_cid in 153 + let%lwt mst = Mem_mst.add mst Keys.a2 leaf_cid in 154 + let%lwt mst = Mem_mst.add mst Keys.g2 leaf_cid in 155 + let%lwt mst = Mem_mst.delete mst Keys.c2 in 156 156 let%lwt proofs = 157 157 Lwt.all 158 - [ MemMst.get_covering_proof mst Keys.a2 159 - ; MemMst.get_covering_proof mst Keys.g2 160 - ; MemMst.get_covering_proof mst Keys.c2 ] 158 + [ Mem_mst.get_covering_proof mst Keys.a2 159 + ; Mem_mst.get_covering_proof mst Keys.g2 160 + ; Mem_mst.get_covering_proof mst Keys.c2 ] 161 161 in 162 162 let proof = 163 163 List.fold_left Storage.Block_map.merge Storage.Block_map.empty proofs 164 164 in 165 165 let proof_mst = mst_of_proof mst.root proof in 166 - let%lwt got_a2 = MemMst.get_cid proof_mst Keys.a2 in 166 + let%lwt got_a2 = Mem_mst.get_cid proof_mst Keys.a2 in 167 167 Alcotest.(check bool) 168 168 "covering proof proves a2" true 169 169 (Option.value 170 170 (Option.map (fun x -> Cid.equal leaf_cid x) got_a2) 171 171 ~default:false ) ; 172 - let%lwt got_g2 = MemMst.get_cid proof_mst Keys.g2 in 172 + let%lwt got_g2 = Mem_mst.get_cid proof_mst Keys.g2 in 173 173 Alcotest.(check bool) 174 174 "covering proof proves g2" true 175 175 (Option.value 176 176 (Option.map (fun x -> Cid.equal leaf_cid x) got_g2) 177 177 ~default:false ) ; 178 - let%lwt got_c2 = MemMst.get_cid proof_mst Keys.c2 in 178 + let%lwt got_c2 = Mem_mst.get_cid proof_mst Keys.c2 in 179 179 Alcotest.(check bool) 180 180 "covering proof proves non-membership of c2" true (got_c2 = None) ; 181 181 Lwt.return_ok () ··· 188 188 in 189 189 let l1root = "bafyreifnqrwbk6ffmyaz5qtujqrzf5qmxf7cbxvgzktl4e3gabuxbtatv4" in 190 190 let l0root = "bafyreie4kjuxbwkhzg2i5dljaswcroeih4dgiqq6pazcmunwt2byd725vi" in 191 - let* mst = MemMst.create_empty store in 191 + let* mst = Mem_mst.create_empty store in 192 192 (* level 0 *) 193 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fn2j" cid1 in 193 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fn2j" cid1 in 194 194 (* level 0 *) 195 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fo2j" cid1 in 195 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fo2j" cid1 in 196 196 (* level 0 *) 197 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fp2j" cid1 in 197 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fp2j" cid1 in 198 198 (* level 1 *) 199 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fs2j" cid1 in 199 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fs2j" cid1 in 200 200 (* level 0 *) 201 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3ft2j" cid1 in 201 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3ft2j" cid1 in 202 202 (* level 0 *) 203 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fu2j" cid1 in 204 - let%lwt cnt = MemMst.leaf_count mst in 203 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fu2j" cid1 in 204 + let%lwt cnt = Mem_mst.leaf_count mst in 205 205 Alcotest.(check int) "leaf count (before delete)" 6 cnt ; 206 - let%lwt layer_before = MemMst.layer mst in 206 + let%lwt layer_before = Mem_mst.layer mst in 207 207 Alcotest.(check int) "root layer before delete" 1 layer_before ; 208 208 let root_before = mst.root in 209 209 Alcotest.(check string) 210 210 "root cid before delete" l1root 211 211 (Cid.to_string root_before) ; 212 212 (* delete level 1 entry, expect trimming to layer 0 *) 213 - let%lwt mst' = MemMst.delete mst "com.example.record/3jqfcqzm3fs2j" in 214 - let%lwt cnt' = MemMst.leaf_count mst' in 213 + let%lwt mst' = Mem_mst.delete mst "com.example.record/3jqfcqzm3fs2j" in 214 + let%lwt cnt' = Mem_mst.leaf_count mst' in 215 215 Alcotest.(check int) "leaf count (after delete)" 5 cnt' ; 216 - let%lwt layer_after = MemMst.layer mst' in 216 + let%lwt layer_after = Mem_mst.layer mst' in 217 217 Alcotest.(check int) "root layer after delete" 0 layer_after ; 218 218 let root_after = mst'.root in 219 219 Alcotest.(check string) ··· 228 228 in 229 229 let l1root = "bafyreiettyludka6fpgp33stwxfuwhkzlur6chs4d2v4nkmq2j3ogpdjem" in 230 230 let l2root = "bafyreid2x5eqs4w4qxvc5jiwda4cien3gw2q6cshofxwnvv7iucrmfohpm" in 231 - let* mst = MemMst.create_empty store in 231 + let* mst = Mem_mst.create_empty store in 232 232 (* A; level 0 *) 233 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fo2j" cid1 in 233 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fo2j" cid1 in 234 234 (* B; level 0 *) 235 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fp2j" cid1 in 235 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fp2j" cid1 in 236 236 (* C; level 0 *) 237 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fr2j" cid1 in 237 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fr2j" cid1 in 238 238 (* D; level 1 *) 239 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fs2j" cid1 in 239 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fs2j" cid1 in 240 240 (* E; level 0 *) 241 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3ft2j" cid1 in 241 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3ft2j" cid1 in 242 242 (* G; level 0 *) 243 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fz2j" cid1 in 243 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fz2j" cid1 in 244 244 (* H; level 0 *) 245 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm4fc2j" cid1 in 245 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm4fc2j" cid1 in 246 246 (* I; level 1 *) 247 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm4fd2j" cid1 in 247 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm4fd2j" cid1 in 248 248 (* J; level 0 *) 249 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm4ff2j" cid1 in 249 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm4ff2j" cid1 in 250 250 (* K; level 0 *) 251 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm4fg2j" cid1 in 251 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm4fg2j" cid1 in 252 252 (* L; level 0 *) 253 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm4fh2j" cid1 in 254 - let%lwt cnt = MemMst.leaf_count mst in 253 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm4fh2j" cid1 in 254 + let%lwt cnt = Mem_mst.leaf_count mst in 255 255 Alcotest.(check int) "leaf count (before F)" 11 cnt ; 256 - let%lwt layer_before = MemMst.layer mst in 256 + let%lwt layer_before = Mem_mst.layer mst in 257 257 Alcotest.(check int) "root layer (before F)" 1 layer_before ; 258 258 let root_before = mst.root in 259 259 Alcotest.(check string) 260 260 "root cid (before F)" l1root 261 261 (Cid.to_string root_before) ; 262 262 (* insert F; level 2 *) 263 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fx2j" cid1 in 264 - let%lwt cnt_after_f = MemMst.leaf_count mst in 263 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fx2j" cid1 in 264 + let%lwt cnt_after_f = Mem_mst.leaf_count mst in 265 265 Alcotest.(check int) "leaf count (after F)" 12 cnt_after_f ; 266 - let%lwt layer_after_f = MemMst.layer mst in 266 + let%lwt layer_after_f = Mem_mst.layer mst in 267 267 Alcotest.(check int) "root layer (after F)" 2 layer_after_f ; 268 268 let root_after_f = mst.root in 269 269 Alcotest.(check string) 270 270 "root cid (after F)" l2root 271 271 (Cid.to_string root_after_f) ; 272 272 (* remove F; should return to previous root/layer *) 273 - let%lwt mst = MemMst.delete mst "com.example.record/3jqfcqzm3fx2j" in 274 - let%lwt cnt_after_del_f = MemMst.leaf_count mst in 273 + let%lwt mst = Mem_mst.delete mst "com.example.record/3jqfcqzm3fx2j" in 274 + let%lwt cnt_after_del_f = Mem_mst.leaf_count mst in 275 275 Alcotest.(check int) "leaf count (after del F)" 11 cnt_after_del_f ; 276 - let%lwt layer_after_del_f = MemMst.layer mst in 276 + let%lwt layer_after_del_f = Mem_mst.layer mst in 277 277 Alcotest.(check int) "root layer (after del F)" 1 layer_after_del_f ; 278 278 let root_after_del_f = mst.root in 279 279 Alcotest.(check string) ··· 290 290 let l0root = "bafyreidfcktqnfmykz2ps3dbul35pepleq7kvv526g47xahuz3rqtptmky" in 291 291 let l2root = "bafyreiavxaxdz7o7rbvr3zg2liox2yww46t7g6hkehx4i4h3lwudly7dhy" in 292 292 let l2root2 = "bafyreig4jv3vuajbsybhyvb7gggvpwh2zszwfyttjrj6qwvcsp24h6popu" in 293 - let* mst = MemMst.create_empty store in 293 + let* mst = Mem_mst.create_empty store in 294 294 (* A; level 0 *) 295 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3ft2j" cid1 in 295 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3ft2j" cid1 in 296 296 (* C; level 0 *) 297 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fz2j" cid1 in 298 - let%lwt cnt = MemMst.leaf_count mst in 297 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fz2j" cid1 in 298 + let%lwt cnt = Mem_mst.leaf_count mst in 299 299 Alcotest.(check int) "leaf count (A,C)" 2 cnt ; 300 - let%lwt layer_ac = MemMst.layer mst in 300 + let%lwt layer_ac = Mem_mst.layer mst in 301 301 Alcotest.(check int) "root layer (A,C)" 0 layer_ac ; 302 302 let root_ac = mst.root in 303 303 Alcotest.(check string) "root cid (A,C)" l0root (Cid.to_string root_ac) ; 304 304 (* insert B (level 2) *) 305 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fx2j" cid1 in 306 - let%lwt cnt_abc = MemMst.leaf_count mst in 305 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fx2j" cid1 in 306 + let%lwt cnt_abc = Mem_mst.leaf_count mst in 307 307 Alcotest.(check int) "leaf count (A,B,C)" 3 cnt_abc ; 308 - let%lwt layer_abc = MemMst.layer mst in 308 + let%lwt layer_abc = Mem_mst.layer mst in 309 309 Alcotest.(check int) "root layer (A,B,C)" 2 layer_abc ; 310 310 let root_abc = mst.root in 311 311 Alcotest.(check string) "root cid (A,B,C)" l2root (Cid.to_string root_abc) ; 312 312 (* remove B → back to l0root *) 313 - let%lwt mst = MemMst.delete mst "com.example.record/3jqfcqzm3fx2j" in 314 - let%lwt cnt_ac = MemMst.leaf_count mst in 313 + let%lwt mst = Mem_mst.delete mst "com.example.record/3jqfcqzm3fx2j" in 314 + let%lwt cnt_ac = Mem_mst.leaf_count mst in 315 315 Alcotest.(check int) "leaf count (A,C again)" 2 cnt_ac ; 316 - let%lwt layer_ac2 = MemMst.layer mst in 316 + let%lwt layer_ac2 = Mem_mst.layer mst in 317 317 Alcotest.(check int) "root layer (A,C again)" 0 layer_ac2 ; 318 318 let root_ac2 = mst.root in 319 319 Alcotest.(check string) "root cid (A,C again)" l0root (Cid.to_string root_ac2) ; 320 320 (* insert B (level 2) and D (level 1) *) 321 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fx2j" cid1 in 322 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm4fd2j" cid1 in 323 - let%lwt cnt_abcd = MemMst.leaf_count mst in 321 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fx2j" cid1 in 322 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm4fd2j" cid1 in 323 + let%lwt cnt_abcd = Mem_mst.leaf_count mst in 324 324 Alcotest.(check int) "leaf count (A,B,C,D)" 4 cnt_abcd ; 325 - let%lwt layer_abcd = MemMst.layer mst in 325 + let%lwt layer_abcd = Mem_mst.layer mst in 326 326 Alcotest.(check int) "root layer (A,B,C,D)" 2 layer_abcd ; 327 327 let root_abcd = mst.root in 328 328 Alcotest.(check string) "root cid (A,B,C,D)" l2root2 (Cid.to_string root_abcd) ; 329 329 (* remove D → match l2root *) 330 - let%lwt mst = MemMst.delete mst "com.example.record/3jqfcqzm4fd2j" in 331 - let%lwt cnt_abc2 = MemMst.leaf_count mst in 330 + let%lwt mst = Mem_mst.delete mst "com.example.record/3jqfcqzm4fd2j" in 331 + let%lwt cnt_abc2 = Mem_mst.leaf_count mst in 332 332 Alcotest.(check int) "leaf count (A,B,C again)" 3 cnt_abc2 ; 333 - let%lwt layer_abc2 = MemMst.layer mst in 333 + let%lwt layer_abc2 = Mem_mst.layer mst in 334 334 Alcotest.(check int) "root layer (A,B,C again)" 2 layer_abc2 ; 335 335 let root_abc2 = mst.root in 336 336 Alcotest.(check string) ··· 375 375 let generate_bulk_data_keys store count = 376 376 let keys = unique_keys count [] in 377 377 Lwt_list.fold_left_s 378 - (fun acc k -> put_random_block store >|= fun cid -> StringMap.add k cid acc) 379 - StringMap.empty keys 378 + (fun acc k -> put_random_block store >|= fun cid -> String_map.add k cid acc) 379 + String_map.empty keys 380 380 381 381 let shuffle lst = 382 382 let arr = Array.of_list lst in ··· 388 388 done ; 389 389 Array.to_list arr 390 390 391 - let assoc_of_map m = StringMap.bindings m 391 + let assoc_of_map m = String_map.bindings m 392 392 393 393 let rec take n lst = 394 394 match (n, lst) with ··· 412 412 413 413 let test_adds () = 414 414 let store = Storage.Memory_blockstore.create () in 415 - let* mst = MemMst.create_empty store in 415 + let* mst = Mem_mst.create_empty store in 416 416 let%lwt mapping = generate_bulk_data_keys store 1000 in 417 417 let shuffled = shuffle (assoc_of_map mapping) in 418 418 let%lwt mst' = 419 - Lwt_list.fold_left_s (fun t (k, v) -> MemMst.add t k v) mst shuffled 419 + Lwt_list.fold_left_s (fun t (k, v) -> Mem_mst.add t k v) mst shuffled 420 420 in 421 421 let%lwt () = 422 422 Lwt_list.iter_s 423 423 (fun (k, v) -> 424 - let%lwt got = MemMst.get_cid mst' k in 424 + let%lwt got = Mem_mst.get_cid mst' k in 425 425 Alcotest.(check bool) 426 426 "added records retrievable" true 427 427 (Option.value ··· 430 430 |> Lwt.return ) 431 431 shuffled 432 432 in 433 - let%lwt total = MemMst.leaf_count mst' in 433 + let%lwt total = Mem_mst.leaf_count mst' in 434 434 Alcotest.(check int) "leaf count after adds" 1000 total ; 435 435 Lwt.return_ok () 436 436 437 437 let test_edits () = 438 438 let store = Storage.Memory_blockstore.create () in 439 - let* mst = MemMst.create_empty store in 439 + let* mst = Mem_mst.create_empty store in 440 440 let%lwt mapping = generate_bulk_data_keys store 1000 in 441 441 let shuffled = shuffle (assoc_of_map mapping) in 442 442 let%lwt mst = 443 - Lwt_list.fold_left_s (fun t (k, v) -> MemMst.add t k v) mst shuffled 443 + Lwt_list.fold_left_s (fun t (k, v) -> Mem_mst.add t k v) mst shuffled 444 444 in 445 445 let to_edit = take 100 shuffled in 446 446 let%lwt edited_mst, edited = 447 447 Lwt_list.fold_left_s 448 448 (fun (t, acc) (k, _old) -> 449 449 let%lwt new_cid = put_random_block store in 450 - MemMst.add t k new_cid >|= fun t' -> (t', (k, new_cid) :: acc) ) 450 + Mem_mst.add t k new_cid >|= fun t' -> (t', (k, new_cid) :: acc) ) 451 451 (mst, []) to_edit 452 452 in 453 453 let edited = List.rev edited in 454 454 let%lwt () = 455 455 Lwt_list.iter_s 456 456 (fun (k, v) -> 457 - let%lwt got = MemMst.get_cid edited_mst k in 457 + let%lwt got = Mem_mst.get_cid edited_mst k in 458 458 Alcotest.(check bool) 459 459 "updated records retrievable" true 460 460 (Option.value ··· 463 463 |> Lwt.return ) 464 464 edited 465 465 in 466 - let%lwt total = MemMst.leaf_count edited_mst in 466 + let%lwt total = Mem_mst.leaf_count edited_mst in 467 467 Alcotest.(check int) "leaf count stable after edits" 1000 total ; 468 468 Lwt.return_ok () 469 469 470 470 let test_deletes () = 471 471 let store = Storage.Memory_blockstore.create () in 472 - let* mst = MemMst.create_empty store in 472 + let* mst = Mem_mst.create_empty store in 473 473 let%lwt mapping = generate_bulk_data_keys store 1000 in 474 474 let shuffled = shuffle (assoc_of_map mapping) in 475 475 let%lwt mst = 476 - Lwt_list.fold_left_s (fun t (k, v) -> MemMst.add t k v) mst shuffled 476 + Lwt_list.fold_left_s (fun t (k, v) -> Mem_mst.add t k v) mst shuffled 477 477 in 478 478 let to_delete, the_rest = 479 479 let rec split n acc rest = ··· 488 488 split 100 [] shuffled 489 489 in 490 490 let%lwt deleted_mst = 491 - Lwt_list.fold_left_s (fun t (k, _) -> MemMst.delete t k) mst to_delete 491 + Lwt_list.fold_left_s (fun t (k, _) -> Mem_mst.delete t k) mst to_delete 492 492 in 493 - let%lwt total = MemMst.leaf_count deleted_mst in 493 + let%lwt total = Mem_mst.leaf_count deleted_mst in 494 494 Alcotest.(check int) "leaf count after deletes" 900 total ; 495 495 let%lwt () = 496 496 Lwt_list.iter_s 497 497 (fun (k, _) -> 498 - let%lwt got = MemMst.get_cid deleted_mst k in 498 + let%lwt got = Mem_mst.get_cid deleted_mst k in 499 499 Alcotest.(check bool) "deleted record missing" true (got = None) 500 500 |> Lwt.return ) 501 501 to_delete ··· 503 503 let%lwt () = 504 504 Lwt_list.iter_s 505 505 (fun (k, v) -> 506 - let%lwt got = MemMst.get_cid deleted_mst k in 506 + let%lwt got = Mem_mst.get_cid deleted_mst k in 507 507 Alcotest.(check bool) 508 508 "remaining records intact" true 509 509 (Option.value ··· 516 516 517 517 let test_order_independent () = 518 518 let store = Storage.Memory_blockstore.create () in 519 - let* mst = MemMst.create_empty store in 519 + let* mst = Mem_mst.create_empty store in 520 520 let%lwt mapping = generate_bulk_data_keys store 1000 in 521 521 let shuffled = shuffle (assoc_of_map mapping) in 522 522 let%lwt mst = 523 - Lwt_list.fold_left_s (fun t (k, v) -> MemMst.add t k v) mst shuffled 523 + Lwt_list.fold_left_s (fun t (k, v) -> Mem_mst.add t k v) mst shuffled 524 524 in 525 - let%lwt all_nodes = MemMst.all_nodes mst in 526 - let* recreated = MemMst.create_empty store in 525 + let%lwt all_nodes = Mem_mst.all_nodes mst in 526 + let* recreated = Mem_mst.create_empty store in 527 527 let reshuffled = shuffle (assoc_of_map mapping) in 528 528 let%lwt recreated = 529 - Lwt_list.fold_left_s (fun t (k, v) -> MemMst.add t k v) recreated reshuffled 529 + Lwt_list.fold_left_s 530 + (fun t (k, v) -> Mem_mst.add t k v) 531 + recreated reshuffled 530 532 in 531 - let%lwt all_reshuffled = MemMst.all_nodes recreated in 533 + let%lwt all_reshuffled = Mem_mst.all_nodes recreated in 532 534 Alcotest.(check int) 533 535 "node count equal" (List.length all_nodes) 534 536 (List.length all_reshuffled) ; ··· 542 544 543 545 let test_save_load () = 544 546 let store = Storage.Memory_blockstore.create () in 545 - let* mst = MemMst.create_empty store in 547 + let* mst = Mem_mst.create_empty store in 546 548 let%lwt mapping = generate_bulk_data_keys store 300 in 547 549 let shuffled = shuffle (assoc_of_map mapping) in 548 550 let%lwt mst = 549 - Lwt_list.fold_left_s (fun t (k, v) -> MemMst.add t k v) mst shuffled 551 + Lwt_list.fold_left_s (fun t (k, v) -> Mem_mst.add t k v) mst shuffled 550 552 in 551 - let loaded = MemMst.create store mst.root in 552 - let%lwt orig_nodes = MemMst.all_nodes mst in 553 - let%lwt loaded_nodes = MemMst.all_nodes loaded in 553 + let loaded = Mem_mst.create store mst.root in 554 + let%lwt orig_nodes = Mem_mst.all_nodes mst in 555 + let%lwt loaded_nodes = Mem_mst.all_nodes loaded in 554 556 Alcotest.(check int) 555 557 "node count equal" (List.length orig_nodes) (List.length loaded_nodes) ; 556 558 List.iter2 ··· 563 565 564 566 let test_diffs () = 565 567 let store = Storage.Memory_blockstore.create () in 566 - let* mst0 = MemMst.create_empty store in 568 + let* mst0 = Mem_mst.create_empty store in 567 569 let%lwt mapping = generate_bulk_data_keys store 1000 in 568 570 let shuffled = shuffle (assoc_of_map mapping) in 569 571 let%lwt mst = 570 - Lwt_list.fold_left_s (fun t (k, v) -> MemMst.add t k v) mst0 shuffled 572 + Lwt_list.fold_left_s (fun t (k, v) -> Mem_mst.add t k v) mst0 shuffled 571 573 in 572 574 (* additions *) 573 575 let%lwt add_map = generate_bulk_data_keys store 100 in ··· 577 579 (* deletes from existing *) 578 580 let to_del = take 100 (drop 400 shuffled) in 579 581 let expected_adds = 580 - List.fold_left (fun m (k, v) -> StringMap.add k v m) StringMap.empty to_add 582 + List.fold_left 583 + (fun m (k, v) -> String_map.add k v m) 584 + String_map.empty to_add 581 585 in 582 586 let%lwt to_diff, expected_updates = 583 587 Lwt_list.fold_left_s 584 588 (fun (t, m) (k, old_v) -> 585 589 let%lwt updated = put_random_block store in 586 - let m' = StringMap.add k (old_v, updated) m in 587 - MemMst.add t k updated >|= fun t' -> (t', m') ) 588 - (mst, StringMap.empty) to_edit 590 + let m' = String_map.add k (old_v, updated) m in 591 + Mem_mst.add t k updated >|= fun t' -> (t', m') ) 592 + (mst, String_map.empty) to_edit 589 593 in 590 594 let%lwt to_diff, expected_dels = 591 595 Lwt_list.fold_left_s 592 596 (fun (t, m) (k, v) -> 593 - MemMst.delete t k >|= fun t' -> (t', StringMap.add k v m) ) 594 - (to_diff, StringMap.empty) to_del 597 + Mem_mst.delete t k >|= fun t' -> (t', String_map.add k v m) ) 598 + (to_diff, String_map.empty) 599 + to_del 595 600 in 596 601 let%lwt to_diff = 597 - Lwt_list.fold_left_s (fun t (k, v) -> MemMst.add t k v) to_diff to_add 602 + Lwt_list.fold_left_s (fun t (k, v) -> Mem_mst.add t k v) to_diff to_add 598 603 in 599 - let%lwt diff = MemDiff.diff ~t_curr:to_diff ~t_prev:mst in 604 + let%lwt diff = Mem_diff.diff ~t_curr:to_diff ~t_prev:mst in 600 605 (* lengths *) 601 606 Alcotest.(check int) "adds length" 100 (List.length diff.adds) ; 602 607 Alcotest.(check int) "updates length" 100 (List.length diff.updates) ; ··· 604 609 (* contents: convert to maps to compare *) 605 610 let adds_map = 606 611 List.fold_left 607 - (fun m (a : Mst.diff_add) -> StringMap.add a.key a.cid m) 608 - StringMap.empty diff.adds 612 + (fun m (a : Mst.diff_add) -> String_map.add a.key a.cid m) 613 + String_map.empty diff.adds 609 614 in 610 615 let updates_map = 611 616 List.fold_left 612 - (fun m (u : Mst.diff_update) -> StringMap.add u.key (u.prev, u.cid) m) 613 - StringMap.empty diff.updates 617 + (fun m (u : Mst.diff_update) -> String_map.add u.key (u.prev, u.cid) m) 618 + String_map.empty diff.updates 614 619 in 615 620 let deletes_map = 616 621 List.fold_left 617 - (fun m (d : Mst.diff_delete) -> StringMap.add d.key d.cid m) 618 - StringMap.empty diff.deletes 622 + (fun m (d : Mst.diff_delete) -> String_map.add d.key d.cid m) 623 + String_map.empty diff.deletes 619 624 in 620 625 (* compare adds *) 621 626 Alcotest.(check int) 622 627 "adds map size equal" 623 - (StringMap.cardinal expected_adds) 624 - (StringMap.cardinal adds_map) ; 625 - StringMap.iter 628 + (String_map.cardinal expected_adds) 629 + (String_map.cardinal adds_map) ; 630 + String_map.iter 626 631 (fun k v -> 627 - match StringMap.find_opt k adds_map with 632 + match String_map.find_opt k adds_map with 628 633 | Some v' -> 629 634 Alcotest.(check bool) "add cid equal" true (Cid.equal v v') 630 635 | None -> ··· 633 638 (* compare updates *) 634 639 Alcotest.(check int) 635 640 "updates map size equal" 636 - (StringMap.cardinal expected_updates) 637 - (StringMap.cardinal updates_map) ; 638 - StringMap.iter 641 + (String_map.cardinal expected_updates) 642 + (String_map.cardinal updates_map) ; 643 + String_map.iter 639 644 (fun k (prev, cid) -> 640 - match StringMap.find_opt k updates_map with 645 + match String_map.find_opt k updates_map with 641 646 | Some (prev', cid') -> 642 647 Alcotest.(check bool) "update prev equal" true (Cid.equal prev prev') ; 643 648 Alcotest.(check bool) "update cid equal" true (Cid.equal cid cid') ··· 647 652 (* compare deletes *) 648 653 Alcotest.(check int) 649 654 "deletes map size equal" 650 - (StringMap.cardinal expected_dels) 651 - (StringMap.cardinal deletes_map) ; 652 - StringMap.iter 655 + (String_map.cardinal expected_dels) 656 + (String_map.cardinal deletes_map) ; 657 + String_map.iter 653 658 (fun k v -> 654 - match StringMap.find_opt k deletes_map with 659 + match String_map.find_opt k deletes_map with 655 660 | Some v' -> 656 661 Alcotest.(check bool) "delete cid equal" true (Cid.equal v v') 657 662 | None -> 658 663 Alcotest.failf "missing delete key %s" k ) 659 664 expected_dels ; 660 665 (* ensure we correctly report all added CIDs *) 661 - let%lwt leaves = MemMst.leaves_of_root to_diff in 666 + let%lwt leaves = Mem_mst.leaves_of_root to_diff in 662 667 let node_cid_set = 663 668 List.fold_left 664 669 (fun s (c, _) -> Cid.Set.add c s) ··· 680 685 681 686 let test_allowable_keys () = 682 687 let store = Storage.Memory_blockstore.create () in 683 - let* mst = MemMst.create_empty store in 688 + let* mst = Mem_mst.create_empty store in 684 689 let cid1 = 685 690 Cid.of_string "bafyreie5cvv4h45feadgeuwhbcutmh6t2ceseocckahdoe6uat64zmz454" 686 691 |> Result.get_ok ··· 688 693 let expect_reject key = 689 694 Lwt.catch 690 695 (fun () -> 691 - MemMst.add mst key cid1 696 + Mem_mst.add mst key cid1 692 697 >>= fun _ -> 693 698 Alcotest.failf "expected invalid key to be rejected: %s" key ) 694 699 (function ··· 698 703 Alcotest.failf "unexpected exception for %s: %s" key 699 704 (Printexc.to_string exn) ) 700 705 in 701 - let expect_allow key = MemMst.add mst key cid1 >|= fun _ -> () in 706 + let expect_allow key = Mem_mst.add mst key cid1 >|= fun _ -> () in 702 707 let* () = expect_reject "" in 703 708 let* () = expect_reject "asdf" in 704 709 let* () = expect_reject "nested/collection/asdf" in ··· 741 746 742 747 let test_empty_root () = 743 748 let store = Storage.Memory_blockstore.create () in 744 - let* mst = MemMst.create_empty store in 745 - let%lwt cnt = MemMst.leaf_count mst in 749 + let* mst = Mem_mst.create_empty store in 750 + let%lwt cnt = Mem_mst.leaf_count mst in 746 751 Alcotest.(check int) "leaf count (empty)" 0 cnt ; 747 752 Alcotest.(check string) 748 753 "empty root cid" ··· 751 756 Lwt.return_ok () 752 757 753 758 let test_trivial_root () = 754 - let store : MemMst.bs = Storage.Memory_blockstore.create () in 759 + let store : Mem_mst.Store.t = Storage.Memory_blockstore.create () in 755 760 let cid1 = 756 761 cid_of_string_exn 757 762 "bafyreie5cvv4h45feadgeuwhbcutmh6t2ceseocckahdoe6uat64zmz454" 758 763 in 759 - let* mst = MemMst.create_empty store in 760 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fo2j" cid1 in 761 - let%lwt cnt = MemMst.leaf_count mst in 764 + let* mst = Mem_mst.create_empty store in 765 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fo2j" cid1 in 766 + let%lwt cnt = Mem_mst.leaf_count mst in 762 767 Alcotest.(check int) "leaf count (trivial)" 1 cnt ; 763 768 Alcotest.(check string) 764 769 "trivial root cid" ··· 772 777 cid_of_string_exn 773 778 "bafyreie5cvv4h45feadgeuwhbcutmh6t2ceseocckahdoe6uat64zmz454" 774 779 in 775 - let* mst = MemMst.create_empty store in 776 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fx2j" cid1 in 777 - let%lwt cnt = MemMst.leaf_count mst in 780 + let* mst = Mem_mst.create_empty store in 781 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fx2j" cid1 in 782 + let%lwt cnt = Mem_mst.leaf_count mst in 778 783 Alcotest.(check int) "leaf count (singlelayer2)" 1 cnt ; 779 - let%lwt layer = MemMst.layer mst in 784 + let%lwt layer = Mem_mst.layer mst in 780 785 Alcotest.(check int) "root layer (singlelayer2)" 2 layer ; 781 786 Alcotest.(check string) 782 787 "singlelayer2 root cid" ··· 790 795 cid_of_string_exn 791 796 "bafyreie5cvv4h45feadgeuwhbcutmh6t2ceseocckahdoe6uat64zmz454" 792 797 in 793 - let* mst = MemMst.create_empty store in 798 + let* mst = Mem_mst.create_empty store in 794 799 (* level 0 *) 795 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fp2j" cid1 in 800 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fp2j" cid1 in 796 801 (* level 0 *) 797 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fr2j" cid1 in 802 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fr2j" cid1 in 798 803 (* level 0 *) 799 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3fs2j" cid1 in 804 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3fs2j" cid1 in 800 805 (* level 1 *) 801 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm3ft2j" cid1 in 806 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm3ft2j" cid1 in 802 807 (* level 0 *) 803 - let%lwt mst = MemMst.add mst "com.example.record/3jqfcqzm4fc2j" cid1 in 808 + let%lwt mst = Mem_mst.add mst "com.example.record/3jqfcqzm4fc2j" cid1 in 804 809 (* level 0 *) 805 - let%lwt cnt = MemMst.leaf_count mst in 810 + let%lwt cnt = Mem_mst.leaf_count mst in 806 811 Alcotest.(check int) "leaf count (simple)" 5 cnt ; 807 812 Alcotest.(check string) 808 813 "simple root cid" ··· 839 844 failwith "root not found in blockstore" 840 845 in 841 846 let mst = 842 - MemMst.create store 843 - ( match StringMap.find "data" commit with 847 + Mem_mst.create store 848 + ( match String_map.find "data" commit with 844 849 | `Link cid -> 845 850 cid 846 851 | _ -> ··· 852 857 let%lwt car = Lwt_io.read ic >|= Bytes.of_string in 853 858 let%lwt () = Lwt_io.close ic in 854 859 let%lwt commit, mst = mst_of_car_bytes car in 855 - let mst_stream = MemMst.to_blocks_stream mst in 860 + let mst_stream = Mem_mst.to_blocks_stream mst in 856 861 let commit_bytes = Dag_cbor.encode (`Map commit) in 857 862 let commit_cid = Cid.create Dcbor commit_bytes in 858 863 let%lwt car' = ··· 860 865 (Lwt_seq.append (Lwt_seq.of_list [(commit_cid, commit_bytes)]) mst_stream) 861 866 in 862 867 let%lwt _, mst' = mst_of_car_bytes car' in 863 - let%lwt eq = MemMst.equal mst mst' in 868 + let%lwt eq = Mem_mst.equal mst mst' in 864 869 Lwt.return (Alcotest.(check bool) "mst roundtrip" true eq) 865 870 866 871 let () =
-1
pegasus/lib/api/repo/createAccount.ml
··· 104 104 let%lwt {commit= commit_cid, commit; _} = 105 105 Repository.apply_writes repo [] None 106 106 in 107 - let open User_store.Types in 108 107 let commit_block = 109 108 commit |> User_store.Types.signed_commit_to_yojson 110 109 |> Dag_cbor.encode_yojson
pegasus/lib/api/server/subscribeRepos.ml pegasus/lib/api/sync/subscribeRepos.ml
+31 -37
pegasus/lib/repository.ml
··· 236 236 237 237 let apply_writes (t : t) (writes : repo_write list) (swap_commit : Cid.t option) 238 238 : write_result Lwt.t = 239 - let%lwt commit = 239 + let module Inductive = Mist.Mst.Inductive (Mst) in 240 + let%lwt prev_commit = 240 241 match%lwt User_store.get_commit t.db with 241 242 | Some (_, commit) -> 242 243 Lwt.return commit ··· 249 250 (Cid.to_string (Option.get swap_commit)) 250 251 (match t.commit with Some (c, _) -> Cid.to_string c | None -> "null") ) ; 251 252 let%lwt block_map = Lwt.map ref (get_map t) in 252 - (* need to cache this so in the end, we only emit new blocks *) 253 - let prev_blocks = 254 - StringMap.bindings !block_map 255 - |> List.fold_left (fun acc (k, v) -> Cid.Map.add v k acc) Cid.Map.empty 256 - in 257 - (* record cbor keyed by cid, needed to calculate covering proofs at the end 258 - we can't do it along the way because covering proofs require the full new mst *) 259 - let added_records = ref Cid.Map.empty in 260 253 (* ops to emit, built in loop because prev_data (previous cid) is otherwise inaccessible *) 261 254 let commit_ops : Sequencer.Types.commit_evt_op list ref = ref [] in 262 255 let%lwt results = ··· 282 275 if StringMap.mem "$type" value then value 283 276 else StringMap.add "$type" (`String collection) value 284 277 in 285 - let%lwt cid, cbor = 278 + let%lwt cid, _ = 286 279 User_store.put_record t.db (`LexMap record_with_type) path 287 280 in 288 281 block_map := StringMap.add path cid !block_map ; 289 - added_records := Cid.Map.add cid (path, cbor) !added_records ; 290 282 commit_ops := 291 283 !commit_ops @ [{action= `Create; path; cid= Some cid; prev= None}] ; 292 284 let refs = ··· 342 334 if StringMap.mem "$type" value then value 343 335 else StringMap.add "$type" (`String collection) value 344 336 in 345 - let%lwt new_cid, cbor = 337 + let%lwt new_cid, _ = 346 338 User_store.put_record t.db (`LexMap record_with_type) path 347 339 in 348 340 block_map := StringMap.add path new_cid !block_map ; 349 - added_records := Cid.Map.add new_cid (path, cbor) !added_records ; 350 341 commit_ops := 351 342 !commit_ops 352 343 @ [{action= `Update; path; cid= Some new_cid; prev= old_cid}] ; ··· 391 382 in 392 383 let%lwt () = User_store.clear_mst t.db in 393 384 let%lwt new_mst = Mst.of_assoc t.db (StringMap.bindings !block_map) in 394 - let%lwt new_commit = put_commit t new_mst.root ~previous:(Some commit) in 395 - let commit_cid, commit_signed = new_commit in 385 + let%lwt new_commit = put_commit t new_mst.root ~previous:(Some prev_commit) in 386 + let new_commit_cid, new_commit_signed = new_commit in 396 387 let commit_block = 397 - commit_signed |> signed_commit_to_yojson |> Dag_cbor.encode_yojson 388 + new_commit_signed |> signed_commit_to_yojson |> Dag_cbor.encode_yojson 398 389 in 399 - let relevant_blocks = ref BlockMap.empty in 400 - let%lwt _ = 401 - (* for each block that wasn't in the previous mst, 402 - commit event `blocks` contains the block itself & its covering proofs *) 403 - List.map 404 - (fun (cid, (path, cbor)) -> 405 - if Cid.Map.mem cid prev_blocks then Lwt.return_unit 406 - else 407 - let%lwt proofs = Mst.get_covering_proof new_mst path in 408 - relevant_blocks := 409 - BlockMap.merge (BlockMap.set cid cbor !relevant_blocks) proofs ; 410 - Lwt.return_unit ) 411 - (Cid.Map.bindings !added_records) 412 - |> Lwt.all 390 + let diff : Inductive.diff list = 391 + List.fold_left 392 + (fun (acc : Inductive.diff list) 393 + ({action; path; cid; prev} : Sequencer.Types.commit_evt_op) -> 394 + match action with 395 + | `Create -> 396 + acc @ [Add {key= path; cid= Option.get cid}] 397 + | `Update -> 398 + acc @ [Update {key= path; cid= Option.get cid; prev}] 399 + | `Delete -> 400 + acc @ [Delete {key= path; prev= Option.get prev}] ) 401 + [] !commit_ops 402 + in 403 + let%lwt proof_blocks = 404 + match%lwt Inductive.generate_proof new_mst diff prev_commit.data with 405 + | Ok blocks -> 406 + Lwt.return blocks 407 + | Error err -> 408 + raise err 413 409 in 414 410 let block_stream = 415 - BlockMap.entries !relevant_blocks 416 - |> Lwt_seq.of_list 417 - |> Lwt_seq.cons (commit_cid, commit_block) 411 + Lwt_seq.of_list proof_blocks |> Lwt_seq.cons (new_commit_cid, commit_block) 418 412 in 419 413 let%lwt blocks = 420 - Car.blocks_to_stream commit_cid block_stream |> Car.collect_stream 414 + Car.blocks_to_stream new_commit_cid block_stream |> Car.collect_stream 421 415 in 422 416 let%lwt ds = Data_store.connect () in 423 417 let%lwt _ = 424 - Sequencer.sequence_commit ds ~did:t.did ~commit:commit_cid 425 - ~rev:commit_signed.rev ~blocks ~ops:!commit_ops ~since:commit.rev 426 - ~prev_data:commit.data () 418 + Sequencer.sequence_commit ds ~did:t.did ~commit:new_commit_cid 419 + ~rev:new_commit_signed.rev ~blocks ~ops:!commit_ops ~since:prev_commit.rev 420 + ~prev_data:prev_commit.data () 427 421 in 428 422 Lwt.return {commit= new_commit; results} 429 423