objective categorical abstract machine language personal data server
xrpc listBlobs
+57
-6
+4
bin/main.ml
+4
bin/main.ml
···
38
38
; (post, "/xrpc/com.atproto.repo.createRecord", Api.Repo.CreateRecord.handler)
39
39
; (post, "/xrpc/com.atproto.repo.putRecord", Api.Repo.PutRecord.handler)
40
40
; (post, "/xrpc/com.atproto.repo.deleteRecord", Api.Repo.DeleteRecord.handler)
41
+
; (post, "/xrpc/com.atproto.repo.uploadBlob", Api.Repo.UploadBlob.handler)
42
+
; (* sync *)
43
+
(get, "/xrpc/com.atproto.sync.getBlob", Api.Sync.GetBlob.handler)
44
+
; (get, "/xrpc/com.atproto.sync.listBlobs", Api.Sync.ListBlobs.handler)
41
45
; (* preferences *)
42
46
( get
43
47
, "/xrpc/com.atproto.actor.getPreferences"
+2
-1
pegasus/lib/api/repo/listRecords.ml
+2
-1
pegasus/lib/api/repo/listRecords.ml
···
37
37
:: results_rev ) )
38
38
("", []) results
39
39
in
40
+
let cursor = if List.length results = limit then Some cursor else None in
40
41
Dream.json @@ Yojson.Safe.to_string
41
-
@@ response_to_yojson {cursor= Some cursor; records= List.rev results_rev} )
42
+
@@ response_to_yojson {cursor; records= List.rev results_rev} )
+24
pegasus/lib/api/sync/listBlobs.ml
+24
pegasus/lib/api/sync/listBlobs.ml
···
1
+
type query =
2
+
{did: string; since: string option; limit: int option; cursor: string option}
3
+
[@@deriving yojson]
4
+
5
+
type response = {cursor: string option; cids: string list} [@@deriving yojson]
6
+
7
+
let handler =
8
+
Xrpc.handler (fun ctx ->
9
+
let {did; since; limit; cursor} =
10
+
Xrpc.parse_query ctx.req query_of_yojson
11
+
in
12
+
let cursor = Option.value ~default:"" cursor in
13
+
let limit =
14
+
match limit with
15
+
| Some limit when limit > 0 && limit <= 1000 ->
16
+
limit
17
+
| _ ->
18
+
1000
19
+
in
20
+
let%lwt db = User_store.connect did in
21
+
let%lwt cids = User_store.list_blobs db ~limit ~cursor ?since in
22
+
let cids = List.map Cid.to_string cids in
23
+
let cursor = if List.length cids = limit then Some cursor else None in
24
+
Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson {cursor; cids} )
+27
-5
pegasus/lib/user_store.ml
+27
-5
pegasus/lib/user_store.ml
···
236
236
{sql| SELECT @int{id}, @CID{cid}, @string{mimetype} FROM blobs WHERE cid = %CID{cid} |sql}
237
237
record_out]
238
238
239
-
let list_blobs ~limit ~cursor =
239
+
let list_blobs =
240
+
[%rapper
241
+
get_many
242
+
{sql| SELECT @CID{cid} FROM blobs WHERE cid > %string{cursor} ORDER BY cid LIMIT %int{limit} |sql}]
243
+
244
+
let list_blobs_since =
240
245
[%rapper
241
246
get_many
242
-
{sql| SELECT @CID{cid} FROM blobs WHERE id > %int{cursor} ORDER BY id LIMIT %int{limit} |sql}]
243
-
~limit ~cursor
247
+
{sql|
248
+
SELECT @CID{cid}
249
+
FROM blobs
250
+
WHERE cid > %string{cursor}
251
+
AND (
252
+
SELECT MIN(records.since)
253
+
FROM blobs_records
254
+
JOIN records ON records.path = blobs_records.record_path
255
+
WHERE blobs_records.blob_id = blobs.id
256
+
) > %string{since}
257
+
ORDER BY cid
258
+
LIMIT %int{limit}
259
+
|sql}]
244
260
245
261
let put_blob cid mimetype =
246
262
[%rapper
···
400
416
in
401
417
Lwt.return_some {id; cid; mimetype; data}
402
418
403
-
let list_blobs t ~limit ~cursor : Cid.t list Lwt.t =
404
-
unwrap @@ Queries.list_blobs t.db ~limit ~cursor
419
+
let list_blobs ?since t ~limit ~cursor : Cid.t list Lwt.t =
420
+
unwrap
421
+
@@
422
+
match since with
423
+
| Some since ->
424
+
Queries.list_blobs_since t.db ~limit ~cursor ~since
425
+
| None ->
426
+
Queries.list_blobs t.db ~limit ~cursor
405
427
406
428
let put_blob t cid mimetype data : int Lwt.t =
407
429
let file =