objective categorical abstract machine language personal data server
Fix retrieving repo root
+23
-13
+23
-13
pegasus/lib/repository.ml
+23
-13
pegasus/lib/repository.ml
···
134
134
; did: string
135
135
; db: Caqti_lwt.connection
136
136
; mutable block_map: Cid.t StringMap.t option
137
-
; mutable root: Cid.t }
137
+
; mutable commit: Cid.t option }
138
138
139
-
let get_map t mst_root : Cid.t StringMap.t Lwt.t =
139
+
let get_map t : Cid.t StringMap.t Lwt.t =
140
+
let%lwt root, commit =
141
+
match%lwt User_store.get_commit t.db with
142
+
| Some (r, c) ->
143
+
Lwt.return (r, c)
144
+
| None ->
145
+
failwith ("failed to retrieve commit for " ^ t.did)
146
+
in
140
147
match t.block_map with
141
-
| Some map ->
148
+
| Some map when Some root = t.commit ->
142
149
Lwt.return map
143
-
| None ->
144
-
let%lwt map = Mst.build_map {blockstore= t.db; root= mst_root} in
150
+
| _ ->
151
+
let%lwt map = Mst.build_map {blockstore= t.db; root= commit.data} in
152
+
t.commit <- Some root ;
145
153
t.block_map <- Some map ;
146
154
Lwt.return map
147
155
148
156
let get_record_cid t path : Cid.t option Lwt.t =
149
-
let%lwt map = get_map t t.root in
157
+
let%lwt map = get_map t in
150
158
Lwt.return @@ StringMap.find_opt path map
151
159
152
160
let get_record t path : record option Lwt.t =
···
154
162
155
163
let list_collections t : string list Lwt.t =
156
164
let module Set = Set.Make (String) in
157
-
let%lwt map = get_map t t.root in
165
+
let%lwt map = get_map t in
158
166
StringMap.bindings map
159
167
|> List.fold_left
160
168
(fun (acc : Set.t) (path, _) ->
···
164
172
|> Set.to_list |> Lwt.return
165
173
166
174
let list_records t collection : (string * Cid.t * record) list Lwt.t =
167
-
let%lwt map = get_map t t.root in
175
+
let%lwt map = get_map t in
168
176
StringMap.bindings map
169
177
|> List.filter (fun (path, _) ->
170
178
String.starts_with ~prefix:(path ^ "/") collection )
···
217
225
let%lwt commit_cid =
218
226
User_store.put_commit t.db signed |> Lwt_result.get_exn
219
227
in
228
+
t.commit <- Some commit_cid ;
220
229
Lwt.return (commit_cid, signed)
221
230
222
231
let put_initial_commit t : (Cid.t * signed_commit) Lwt.t =
···
232
241
| Some (_, commit) ->
233
242
Lwt.return commit
234
243
| None ->
235
-
failwith "failed to find commit for repo"
244
+
failwith ("failed to retrieve commit for " ^ t.did)
236
245
in
237
-
if swap_commit <> None && swap_commit <> Some t.root then
246
+
if swap_commit <> None && swap_commit <> t.commit then
238
247
raise
239
248
(XrpcError
240
249
( "InvalidSwap"
241
-
, Format.sprintf "swapRecord cid %s did not match commit cid %s"
250
+
, Format.sprintf "swapCommit cid %s did not match last commit cid %s"
242
251
(Cid.to_string (Option.get swap_commit))
243
-
(Cid.to_string t.root) ) ) ;
244
-
let%lwt block_map = Lwt.map ref (get_map t commit.data) in
252
+
(match t.commit with Some c -> Cid.to_string c | None -> "null") )
253
+
) ;
254
+
let%lwt block_map = Lwt.map ref (get_map t) in
245
255
let%lwt results =
246
256
List.map
247
257
(fun (w : repo_write) ->