objective categorical abstract machine language personal data server
No need to pass db to Repository.load now either
+50
-53
+1
-2
pegasus/lib/api/admin_/users.ml
+1
-2
pegasus/lib/api/admin_/users.ml
+1
-1
pegasus/lib/api/repo/importRepo.ml
+1
-1
pegasus/lib/api/repo/importRepo.ml
···
13
13
let did = Auth.get_authed_did_exn ctx.auth in
14
14
let bytes_stream = Dream.body_stream ctx.req in
15
15
let car_stream = stream_to_seq bytes_stream in
16
-
let%lwt repo = Repository.load did ~ds:ctx.db ~ensure_active:true in
16
+
let%lwt repo = Repository.load did ~ensure_active:true in
17
17
let%lwt result = Repository.import_car repo car_stream in
18
18
match result with
19
19
| Ok _ ->
+1
-1
pegasus/lib/api/server/checkAccountStatus.ml
+1
-1
pegasus/lib/api/server/checkAccountStatus.ml
+1
-1
pegasus/lib/api/server/createAccount.ml
+1
-1
pegasus/lib/api/server/createAccount.ml
+1
-3
pegasus/lib/api/sync/getBlob.ml
+1
-3
pegasus/lib/api/sync/getBlob.ml
···
4
4
Xrpc.handler (fun ctx ->
5
5
let {did; cid} = Xrpc.parse_query ctx.req query_of_yojson in
6
6
let cid_parsed = Cid.as_cid cid in
7
-
let%lwt {db; _} =
8
-
Repository.load did ~ensure_active:true ~ds:ctx.db
9
-
in
7
+
let%lwt {db; _} = Repository.load did ~ensure_active:true in
10
8
let%lwt blob_meta = User_store.get_blob_metadata db cid_parsed in
11
9
match blob_meta with
12
10
| None ->
+1
-3
pegasus/lib/api/sync/getBlocks.ml
+1
-3
pegasus/lib/api/sync/getBlocks.ml
···
4
4
let handler =
5
5
Xrpc.handler (fun ctx ->
6
6
let {did; cids} : query = Xrpc.parse_query ctx.req query_of_yojson in
7
-
let%lwt {db; commit; _} =
8
-
Repository.load did ~ensure_active:true ~ds:ctx.db
9
-
in
7
+
let%lwt {db; commit; _} = Repository.load did ~ensure_active:true in
10
8
let commit_cid, commit_signed = Option.get commit in
11
9
let commit_block =
12
10
commit_signed |> User_store.Types.signed_commit_to_yojson
+1
-3
pegasus/lib/api/sync/getLatestCommit.ml
+1
-3
pegasus/lib/api/sync/getLatestCommit.ml
···
5
5
let handler =
6
6
Xrpc.handler (fun ctx ->
7
7
let {did} : query = Xrpc.parse_query ctx.req query_of_yojson in
8
-
match%lwt
9
-
Repository.load did ~ensure_active:true ~ds:ctx.db
10
-
with
8
+
match%lwt Repository.load did ~ensure_active:true with
11
9
| {commit= Some (cid, {rev; _}); _} ->
12
10
let cid = Cid.to_string cid in
13
11
Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson {cid; rev}
+1
-3
pegasus/lib/api/sync/getRecord.ml
+1
-3
pegasus/lib/api/sync/getRecord.ml
···
9
9
Xrpc.parse_query ctx.req query_of_yojson
10
10
in
11
11
let path = collection ^ "/" ^ rkey in
12
-
let%lwt repo =
13
-
Repository.load did ~ensure_active:true ~ds:ctx.db
14
-
in
12
+
let%lwt repo = Repository.load did ~ensure_active:true in
15
13
match%lwt Repository.get_record repo path with
16
14
| None ->
17
15
Printf.ksprintf
+1
-1
pegasus/lib/api/sync/getRepoStatus.ml
+1
-1
pegasus/lib/api/sync/getRepoStatus.ml
···
15
15
Errors.invalid_request ~name:"RepoNotFound"
16
16
"couldn't find a repo with that did"
17
17
in
18
-
let%lwt {db= user_db; _} = Repository.load did ~ds:ctx.db in
18
+
let%lwt {db= user_db; _} = Repository.load did in
19
19
let%lwt _, commit =
20
20
match%lwt User_store.get_commit user_db with
21
21
| Some c ->
+1
-3
pegasus/lib/api/sync/listBlobs.ml
+1
-3
pegasus/lib/api/sync/listBlobs.ml
···
21
21
| _ ->
22
22
1000
23
23
in
24
-
let%lwt {db; _} =
25
-
Repository.load did ~ensure_active:true ~ds:ctx.db
26
-
in
24
+
let%lwt {db; _} = Repository.load did ~ensure_active:true in
27
25
let%lwt cids = User_store.list_blobs db ~limit ~cursor ?since in
28
26
let cids = List.map Cid.to_string cids in
29
27
let cursor =
+19
-14
pegasus/lib/data_store.ml
+19
-14
pegasus/lib/data_store.ml
···
323
323
let pool_mutex = Lwt_mutex.create ()
324
324
325
325
let connect ?create () : t Lwt.t =
326
-
Lwt_mutex.with_lock pool_mutex (fun () ->
327
-
match !pool with
328
-
| Some pool ->
329
-
Lwt.return pool
330
-
| None ->
331
-
if create = Some true then
332
-
Util.mkfile_p Util.Constants.pegasus_db_filepath ~perm:0o644 ;
333
-
let%lwt db =
334
-
Util.connect_sqlite ?create ~write:true
335
-
Util.Constants.pegasus_db_location
336
-
in
337
-
let%lwt () = Migrations.run_migrations Data_store db in
338
-
pool := Some db ;
339
-
Lwt.return db )
326
+
match !pool with
327
+
| Some pool ->
328
+
Lwt.return pool
329
+
| None ->
330
+
Lwt_mutex.with_lock pool_mutex (fun () ->
331
+
(* pool might've been initialized while we were waiting for the mutex *)
332
+
match !pool with
333
+
| Some pool ->
334
+
Lwt.return pool
335
+
| None ->
336
+
if create = Some true then
337
+
Util.mkfile_p Util.Constants.pegasus_db_filepath ~perm:0o644 ;
338
+
let%lwt db =
339
+
Util.connect_sqlite ?create ~write:true
340
+
Util.Constants.pegasus_db_location
341
+
in
342
+
let%lwt () = Migrations.run_migrations Data_store db in
343
+
pool := Some db ;
344
+
Lwt.return db )
340
345
341
346
let create_actor ~did ~handle ~email ~password ~signing_key conn =
342
347
let password_hash = Bcrypt.hash password |> Bcrypt.string_of_hash in
+3
-5
pegasus/lib/repository.ml
+3
-5
pegasus/lib/repository.ml
···
502
502
Dream.debug (fun l -> l "commit sequenced") ;
503
503
Lwt.return {commit= new_commit; results} )
504
504
505
-
let load ?create ?(ensure_active = false) ?ds did : t Lwt.t =
506
-
let%lwt data_store_conn =
507
-
match ds with Some ds -> Lwt.return ds | None -> Data_store.connect ()
508
-
in
505
+
let load ?create ?(ensure_active = false) did : t Lwt.t =
506
+
let%lwt ds_conn = Data_store.connect () in
509
507
let%lwt user_db =
510
508
try%lwt User_store.connect ?create did
511
509
with _ ->
···
513
511
"your princess is in another castle"
514
512
in
515
513
let%lwt {signing_key; _} =
516
-
match%lwt Data_store.get_actor_by_identifier did data_store_conn with
514
+
match%lwt Data_store.get_actor_by_identifier did ds_conn with
517
515
| Some actor when ensure_active = false || actor.deactivated_at = None ->
518
516
Lwt.return actor
519
517
| Some _ ->
+18
-13
pegasus/lib/user_store.ml
+18
-13
pegasus/lib/user_store.ml
···
315
315
let pool_cache_mutex = Lwt_mutex.create ()
316
316
317
317
let connect ?create did : t Lwt.t =
318
-
Lwt_mutex.with_lock pool_cache_mutex (fun () ->
319
-
match Hashtbl.find_opt pool_cache did with
320
-
| Some cached ->
321
-
Lwt.return cached
322
-
| None ->
323
-
let%lwt db =
324
-
Util.connect_sqlite ?create ~write:true
325
-
(Util.Constants.user_db_location did)
326
-
in
327
-
let%lwt () = Migrations.run_migrations User_store db in
328
-
let t = {did; db} in
329
-
Hashtbl.replace pool_cache did t ;
330
-
Lwt.return t )
318
+
match Hashtbl.find_opt pool_cache did with
319
+
| Some cached ->
320
+
Lwt.return cached
321
+
| None ->
322
+
Lwt_mutex.with_lock pool_cache_mutex (fun () ->
323
+
(* pool might've been initialized while we were waiting for the mutex *)
324
+
match Hashtbl.find_opt pool_cache did with
325
+
| Some cached ->
326
+
Lwt.return cached
327
+
| None ->
328
+
let%lwt db =
329
+
Util.connect_sqlite ?create ~write:true
330
+
(Util.Constants.user_db_location did)
331
+
in
332
+
let%lwt () = Migrations.run_migrations User_store db in
333
+
let t = {did; db} in
334
+
Hashtbl.replace pool_cache did t ;
335
+
Lwt.return t )
331
336
332
337
(* mst blocks; implements Writable_blockstore *)
333
338