objective categorical abstract machine language personal data server
xrpc uploadBlob, getBlob
+46
-7
+7
-2
mist/lib/blob_ref.ml
+7
-2
mist/lib/blob_ref.ml
···
1
1
module StringMap = Dag_cbor.StringMap
2
2
3
-
type typed_json_ref = {type': string; ref: Cid.t; mime_type: string; size: int64}
3
+
type typed_json_ref =
4
+
{ type': string [@key "$type"]
5
+
; ref: Cid.t
6
+
; mime_type: string [@key "mimeType"]
7
+
; size: int64 }
8
+
[@@deriving yojson]
4
9
5
-
type untyped_json_ref = {cid: string; mime_type: string}
10
+
type untyped_json_ref = {cid: string; mime_type: string [@key "mimeType"]}
6
11
7
12
type json_ref = Typed of typed_json_ref | Untyped of untyped_json_ref
8
13
+1
-1
pegasus/lib/api/repo/getRecord.ml
+1
-1
pegasus/lib/api/repo/getRecord.ml
+1
-1
pegasus/lib/api/repo/listRecords.ml
+1
-1
pegasus/lib/api/repo/listRecords.ml
+16
pegasus/lib/api/repo/uploadBlob.ml
+16
pegasus/lib/api/repo/uploadBlob.ml
···
1
+
type response = {blob: Mist.Blob_ref.typed_json_ref} [@@deriving yojson]
2
+
3
+
let handler =
4
+
Xrpc.handler ~auth:Auth.Verifiers.access (fun ctx ->
5
+
let did = Auth.get_authed_did_exn ctx.auth in
6
+
let mime_type =
7
+
Option.value ~default:"application/octet-stream"
8
+
(Dream.header ctx.req "Content-Type")
9
+
in
10
+
let%lwt data = Dream.body ctx.req |> Lwt.map Bytes.of_string in
11
+
let size = Int64.of_int @@ Bytes.length data in
12
+
let cid = Cid.create Raw data in
13
+
let%lwt user_db = User_store.connect did in
14
+
let%lwt _ = User_store.put_blob user_db cid mime_type data in
15
+
Dream.json @@ Yojson.Safe.to_string
16
+
@@ response_to_yojson {blob= {type'= "blob"; ref= cid; mime_type; size}} )
+18
pegasus/lib/api/sync/getBlob.ml
+18
pegasus/lib/api/sync/getBlob.ml
···
1
+
type query = {did: string; cid: string} [@@deriving yojson]
2
+
3
+
let handler =
4
+
Xrpc.handler (fun ctx ->
5
+
let {did; cid} = Xrpc.parse_query ctx.req query_of_yojson in
6
+
let cid = Cid.as_cid cid in
7
+
let%lwt db = User_store.connect did in
8
+
let%lwt blob =
9
+
match%lwt User_store.get_blob db cid with
10
+
| Some blob ->
11
+
Lwt.return blob
12
+
| None ->
13
+
Errors.internal_error ~msg:"blob not found" ()
14
+
in
15
+
Lwt.return
16
+
@@ Dream.response
17
+
~headers:[("Content-Type", blob.mimetype)]
18
+
(Bytes.to_string blob.data) )
+3
-3
pegasus/lib/xrpc.ml
+3
-3
pegasus/lib/xrpc.ml
···
24
24
exn_to_response e
25
25
26
26
let parse_query (req : Dream.request)
27
-
(of_yojson : Yojson.Safe.t -> ('a, string) result) : 'a Lwt.t =
28
-
try%lwt
27
+
(of_yojson : Yojson.Safe.t -> ('a, string) result) : 'a =
28
+
try
29
29
let queries = Dream.all_queries req in
30
30
let query_json =
31
31
`Assoc (List.map (fun (k, v) -> (k, Yojson.Safe.from_string v)) queries)
32
32
in
33
-
query_json |> of_yojson |> Result.get_ok |> Lwt.return
33
+
query_json |> of_yojson |> Result.get_ok
34
34
with _ -> Errors.invalid_request "Invalid query string"
35
35
36
36
let parse_body (req : Dream.request)