objective categorical abstract machine language personal data server
Fix inductive proof generation
+306
-253
+76
-21
mist/lib/mst.ml
+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
+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
-1
pegasus/lib/api/repo/createAccount.ml
pegasus/lib/api/server/subscribeRepos.ml
pegasus/lib/api/sync/subscribeRepos.ml
pegasus/lib/api/server/subscribeRepos.ml
pegasus/lib/api/sync/subscribeRepos.ml
+31
-37
pegasus/lib/repository.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