objective categorical abstract machine language personal data server
xrpc putRecord, deleteRecord
+116
+52
pegasus/lib/api/repo/deleteRecord.ml
+52
pegasus/lib/api/repo/deleteRecord.ml
···
1
+
type request =
2
+
{ repo: string
3
+
; collection: string
4
+
; rkey: string
5
+
; swap_record: Cid.t option [@key "swapRecord"]
6
+
; swap_commit: Cid.t option [@key "swapCommit"] }
7
+
[@@deriving yojson]
8
+
9
+
type response = {commit: res_commit option} [@@deriving yojson]
10
+
11
+
and res_commit = {cid: Cid.t; rev: string} [@@deriving yojson]
12
+
13
+
let handler =
14
+
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun ctx ->
15
+
let%lwt input = Xrpc.parse_body ctx.req request_of_yojson in
16
+
let%lwt input_did =
17
+
if String.starts_with ~prefix:"did:" input.repo then
18
+
Lwt.return input.repo
19
+
else
20
+
match%lwt Data_store.get_actor_by_identifier input.repo ctx.db with
21
+
| Some {did; _} ->
22
+
Lwt.return did
23
+
| None ->
24
+
Errors.invalid_request "target repository not found"
25
+
in
26
+
let did =
27
+
match ctx.auth with
28
+
| Access {did} when did = input_did ->
29
+
did
30
+
| Admin ->
31
+
input_did
32
+
| _ ->
33
+
Errors.auth_required
34
+
"authentication does not match target repository"
35
+
in
36
+
let%lwt repo = Repository.load did in
37
+
let write : Repository.repo_write =
38
+
Delete
39
+
{ type'= Repository.Write_op.delete
40
+
; collection= input.collection
41
+
; rkey= input.rkey
42
+
; swap_record= input.swap_record }
43
+
in
44
+
let%lwt {commit= commit_cid, {rev; _}; results} =
45
+
Repository.apply_writes repo [write] input.swap_commit
46
+
in
47
+
match List.hd results with
48
+
| Delete _ ->
49
+
Dream.json @@ Yojson.Safe.to_string
50
+
@@ response_to_yojson {commit= Some {cid= commit_cid; rev}}
51
+
| _ ->
52
+
Errors.invalid_request "unexpected create or update result" )
+64
pegasus/lib/api/repo/putRecord.ml
+64
pegasus/lib/api/repo/putRecord.ml
···
1
+
type request =
2
+
{ repo: string
3
+
; collection: string
4
+
; rkey: string
5
+
; validate: bool option
6
+
; record: Mist.Lex.repo_record
7
+
; swap_record: Cid.t option [@key "swapRecord"]
8
+
; swap_commit: Cid.t option [@key "swapCommit"] }
9
+
[@@deriving yojson]
10
+
11
+
type response =
12
+
{ uri: string
13
+
; cid: Cid.t
14
+
; commit: res_commit option
15
+
; validation_status: string option [@key "validationStatus"] }
16
+
[@@deriving yojson]
17
+
18
+
and res_commit = {cid: Cid.t; rev: string} [@@deriving yojson]
19
+
20
+
let handler =
21
+
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun ctx ->
22
+
let%lwt input = Xrpc.parse_body ctx.req request_of_yojson in
23
+
let%lwt input_did =
24
+
if String.starts_with ~prefix:"did:" input.repo then
25
+
Lwt.return input.repo
26
+
else
27
+
match%lwt Data_store.get_actor_by_identifier input.repo ctx.db with
28
+
| Some {did; _} ->
29
+
Lwt.return did
30
+
| None ->
31
+
Errors.invalid_request "target repository not found"
32
+
in
33
+
let did =
34
+
match ctx.auth with
35
+
| Access {did} when did = input_did ->
36
+
did
37
+
| Admin ->
38
+
input_did
39
+
| _ ->
40
+
Errors.auth_required
41
+
"authentication does not match target repository"
42
+
in
43
+
let%lwt repo = Repository.load did in
44
+
let write : Repository.repo_write =
45
+
Update
46
+
{ type'= Repository.Write_op.update
47
+
; collection= input.collection
48
+
; rkey= input.rkey
49
+
; value= input.record
50
+
; swap_record= input.swap_record }
51
+
in
52
+
let%lwt {commit= commit_cid, {rev; _}; results} =
53
+
Repository.apply_writes repo [write] input.swap_commit
54
+
in
55
+
match List.hd results with
56
+
| Create {uri; cid; _} | Update {uri; cid; _} ->
57
+
Dream.json @@ Yojson.Safe.to_string
58
+
@@ response_to_yojson
59
+
{ uri
60
+
; cid
61
+
; commit= Some {cid= commit_cid; rev}
62
+
; validation_status= Some "valid" }
63
+
| _ ->
64
+
Errors.invalid_request "unexpected delete result" )