objective categorical abstract machine language personal data server
xrpc checkAccountStatus
+84
+3
bin/main.ml
+3
bin/main.ml
···
51
51
; ( post
52
52
, "/xrpc/com.atproto.server.deleteSession"
53
53
, Api.Server.DeleteSession.handler )
54
+
; ( get
55
+
, "/xrpc/com.atproto.server.checkAccountStatus"
56
+
, Api.Server.CheckAccountStatus.handler )
54
57
; ( post
55
58
, "/xrpc/com.atproto.identity.updateHandle"
56
59
, Api.Identity.UpdateHandle.handler )
+52
pegasus/lib/api/server/checkAccountStatus.ml
+52
pegasus/lib/api/server/checkAccountStatus.ml
···
1
+
type response =
2
+
{ activated: bool
3
+
; valid_did: bool [@key "validDid"]
4
+
; repo_commit: string [@key "repoCommit"]
5
+
; repo_rev: string [@key "repoRev"]
6
+
; repo_blocks: int [@key "repoBlocks"]
7
+
; indexed_records: int [@key "indexedRecords"]
8
+
; private_state_values: int [@key "privateStateValues"]
9
+
; expected_blobs: int [@key "expectedBlobs"]
10
+
; imported_blobs: int [@key "importedBlobs"] }
11
+
[@@deriving yojson {strict= false}]
12
+
13
+
let handler =
14
+
Xrpc.handler (fun {db; auth; _} ->
15
+
let did = Auth.get_authed_did_exn auth in
16
+
match%lwt Data_store.get_actor_by_identifier did db with
17
+
| None ->
18
+
Errors.internal_error ~msg:"actor not found" ()
19
+
| Some actor -> (
20
+
let%lwt {db= us; commit; _} =
21
+
Repository.load ~write:false ~ds:db did
22
+
in
23
+
let%lwt cid, commit =
24
+
match commit with
25
+
| Some c ->
26
+
Lwt.return c
27
+
| None ->
28
+
User_store.get_commit us |> Lwt.map Option.get
29
+
in
30
+
let repo_commit, repo_rev = (Cid.to_string cid, commit.rev) in
31
+
match%lwt
32
+
Lwt.all
33
+
[ User_store.count_blocks us
34
+
; User_store.count_records us
35
+
; User_store.count_blobs us
36
+
; User_store.count_referenced_blobs us ]
37
+
with
38
+
| [block_count; indexed_records; imported_blobs; expected_blobs] ->
39
+
(* mst blocks + records + commit *)
40
+
let repo_blocks = block_count + indexed_records + 1 in
41
+
{ activated= actor.deactivated_at <> None
42
+
; valid_did= true
43
+
; repo_commit
44
+
; repo_rev
45
+
; repo_blocks
46
+
; indexed_records
47
+
; private_state_values= 0
48
+
; expected_blobs
49
+
; imported_blobs }
50
+
|> response_to_yojson |> Yojson.Safe.to_string |> Dream.json
51
+
| _ ->
52
+
Errors.internal_error ~msg:"failed to load account data" () ) )
+29
pegasus/lib/user_store.ml
+29
pegasus/lib/user_store.ml
···
125
125
126
126
let clear_mst = [%rapper execute {sql| DELETE FROM mst |sql}] ()
127
127
128
+
(* mst misc *)
129
+
let count_blocks =
130
+
[%rapper get_one {sql| SELECT @int{COUNT(*)} FROM mst |sql}]
131
+
128
132
(* repo commit *)
129
133
let get_commit =
130
134
[%rapper
···
186
190
AND (since < %string{cursor} OR %string{cursor} = '')
187
191
ORDER BY since DESC LIMIT %int{limit}
188
192
|sql}]
193
+
194
+
let count_records =
195
+
[%rapper get_one {sql| SELECT @int{COUNT(*)} FROM records |sql}]
189
196
190
197
let list_records_reverse =
191
198
[%rapper
···
259
266
LIMIT %int{limit}
260
267
|sql}]
261
268
269
+
let count_blobs =
270
+
[%rapper get_one {sql| SELECT @int{COUNT(*)} FROM blobs |sql}]
271
+
272
+
let count_referenced_blobs =
273
+
[%rapper
274
+
get_one
275
+
{sql| SELECT @int{COUNT(*)} FROM blobs WHERE cid IN (
276
+
SELECT blob_id FROM blobs_records
277
+
)
278
+
|sql}]
279
+
262
280
let put_blob cid mimetype =
263
281
[%rapper
264
282
get_one
···
383
401
let%lwt () = Util.use_pool t.db Queries.clear_mst in
384
402
Lwt.return_unit
385
403
404
+
(* mst misc *)
405
+
406
+
let count_blocks t : int Lwt.t = Util.use_pool t.db @@ Queries.count_blocks ()
407
+
386
408
(* repo commit *)
387
409
388
410
let get_commit t : (Cid.t * signed_commit) option Lwt.t =
···
423
445
Util.use_pool t.db @@ fn ~collection ~limit ~cursor
424
446
>|= List.map (fun (path, cid, data, since) ->
425
447
{path; cid; value= Lex.of_cbor data; since} )
448
+
449
+
let count_records t : int Lwt.t = Util.use_pool t.db @@ Queries.count_records ()
426
450
427
451
let put_record t record path : (Cid.t * bytes) Lwt.t =
428
452
let cid, data = Lex.to_cbor_block record in
···
472
496
Queries.list_blobs_since ~limit ~cursor ~since
473
497
| None ->
474
498
Queries.list_blobs ~limit ~cursor
499
+
500
+
let count_blobs t : int Lwt.t = Util.use_pool t.db @@ Queries.count_blobs ()
501
+
502
+
let count_referenced_blobs t : int Lwt.t =
503
+
Util.use_pool t.db @@ Queries.count_referenced_blobs ()
475
504
476
505
let put_blob t cid mimetype data : int Lwt.t =
477
506
let file =