objective categorical abstract machine language personal data server
Admin xrpc endpoints
+197
-2
+20
bin/main.ml
+20
bin/main.ml
···
38
38
; ( get
39
39
, "/xrpc/com.atproto.identity.resolveHandle"
40
40
, Api.Identity.ResolveHandle.handler )
41
+
; (* admin *)
42
+
( post
43
+
, "/xrpc/com.atproto.admin.deleteAccount"
44
+
, Api.Admin.DeleteAccount.handler )
45
+
; ( get
46
+
, "/xrpc/com.atproto.admin.getAccountInfo"
47
+
, Api.Admin.GetAccountInfo.handler )
48
+
; ( get
49
+
, "/xrpc/com.atproto.admin.getAccountInfos"
50
+
, Api.Admin.GetAccountInfos.handler )
51
+
; ( get
52
+
, "/xrpc/com.atproto.admin.getInviteCodes"
53
+
, Api.Admin.GetInviteCodes.handler )
54
+
; (post, "/xrpc/com.atproto.admin.sendEmail", Api.Admin.SendEmail.handler)
55
+
; ( post
56
+
, "/xrpc/com.atproto.admin.updateAccountEmail"
57
+
, Api.Admin.UpdateAccountEmail.handler )
58
+
; ( post
59
+
, "/xrpc/com.atproto.admin.updateAccountHandle"
60
+
, Api.Admin.UpdateAccountHandle.handler )
41
61
; (* account management *)
42
62
( post
43
63
, "/xrpc/com.atproto.server.createInviteCode"
+11
pegasus/lib/api/admin/deleteAccount.ml
+11
pegasus/lib/api/admin/deleteAccount.ml
···
1
+
type request = {did: string} [@@deriving yojson {strict= false}]
2
+
3
+
let handler =
4
+
Xrpc.handler ~auth:Admin (fun {req; db; _} ->
5
+
let%lwt {did} = Xrpc.parse_body req request_of_yojson in
6
+
match%lwt Data_store.get_actor_by_identifier did db with
7
+
| None ->
8
+
Errors.invalid_request "account not found"
9
+
| Some _ ->
10
+
let%lwt _ = Server.DeleteAccount.delete_account ~did db in
11
+
Dream.empty `OK )
+28
pegasus/lib/api/admin/getAccountInfo.ml
+28
pegasus/lib/api/admin/getAccountInfo.ml
···
1
+
type account_view =
2
+
{ did: string
3
+
; handle: string
4
+
; email: string
5
+
; email_confirmed_at: string option [@key "emailConfirmedAt"]
6
+
; indexed_at: string [@key "indexedAt"]
7
+
; deactivated_at: string option [@key "deactivatedAt"] }
8
+
[@@deriving yojson {strict= false}]
9
+
10
+
type response = account_view [@@deriving yojson {strict= false}]
11
+
12
+
let actor_to_account_view (actor : Data_store.Types.actor) : account_view =
13
+
{ did= actor.did
14
+
; handle= actor.handle
15
+
; email= actor.email
16
+
; email_confirmed_at= Option.map Util.ms_to_iso8601 actor.email_confirmed_at
17
+
; indexed_at= Util.ms_to_iso8601 actor.created_at
18
+
; deactivated_at= Option.map Util.ms_to_iso8601 actor.deactivated_at }
19
+
20
+
let handler =
21
+
Xrpc.handler ~auth:Admin (fun {req; db; _} ->
22
+
let did = Dream.query req "did" |> Option.value ~default:"" in
23
+
match%lwt Data_store.get_actor_by_identifier did db with
24
+
| None ->
25
+
Errors.invalid_request "account not found"
26
+
| Some actor ->
27
+
let response = actor_to_account_view actor in
28
+
Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson response )
+21
pegasus/lib/api/admin/getAccountInfos.ml
+21
pegasus/lib/api/admin/getAccountInfos.ml
···
1
+
type response = {infos: GetAccountInfo.account_view list}
2
+
[@@deriving yojson {strict= false}]
3
+
4
+
let handler =
5
+
Xrpc.handler ~auth:Admin (fun {req; db; _} ->
6
+
let dids =
7
+
Dream.query req "dids" |> Option.value ~default:""
8
+
|> String.split_on_char ','
9
+
|> List.filter (fun s -> String.length s > 0)
10
+
in
11
+
let%lwt infos =
12
+
Lwt_list.filter_map_s
13
+
(fun did ->
14
+
match%lwt Data_store.get_actor_by_identifier did db with
15
+
| None ->
16
+
Lwt.return_none
17
+
| Some actor ->
18
+
Lwt.return_some (GetAccountInfo.actor_to_account_view actor) )
19
+
dids
20
+
in
21
+
Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson {infos} )
+40
pegasus/lib/api/admin/getInviteCodes.ml
+40
pegasus/lib/api/admin/getInviteCodes.ml
···
1
+
type invite_code_use =
2
+
{used_by: string [@key "usedBy"]; used_at: string [@key "usedAt"]}
3
+
[@@deriving yojson {strict= false}]
4
+
5
+
type invite_code =
6
+
{ code: string
7
+
; available: int
8
+
; disabled: bool
9
+
; for_account: string [@key "forAccount"]
10
+
; created_by: string [@key "createdBy"]
11
+
; created_at: string [@key "createdAt"]
12
+
; uses: invite_code_use list }
13
+
[@@deriving yojson {strict= false}]
14
+
15
+
type response = {codes: invite_code list; cursor: string option [@default None]}
16
+
[@@deriving yojson {strict= false}]
17
+
18
+
let handler =
19
+
Xrpc.handler ~auth:Admin (fun {req; db; _} ->
20
+
let _sort = Dream.query req "sort" |> Option.value ~default:"recent" in
21
+
let limit =
22
+
Dream.query req "limit" |> Option.map int_of_string
23
+
|> Option.value ~default:100
24
+
in
25
+
let _cursor = Dream.query req "cursor" in
26
+
let%lwt db_codes = Data_store.list_invites ~limit db in
27
+
let codes =
28
+
List.map
29
+
(fun (ic : Data_store.Types.invite_code) ->
30
+
{ code= ic.code
31
+
; available= ic.remaining
32
+
; disabled= ic.remaining = 0
33
+
; for_account= ic.did
34
+
; created_by= ""
35
+
; created_at= ""
36
+
; uses= [] } )
37
+
db_codes
38
+
in
39
+
Dream.json @@ Yojson.Safe.to_string
40
+
@@ response_to_yojson {codes; cursor= None} )
+35
pegasus/lib/api/admin/sendEmail.ml
+35
pegasus/lib/api/admin/sendEmail.ml
···
1
+
type request =
2
+
{ recipient_did: string [@key "recipientDid"]
3
+
; content: string
4
+
; subject: string option [@default None]
5
+
; sender_did: string [@key "senderDid"]
6
+
; comment: string option [@default None] }
7
+
[@@deriving yojson {strict= false}]
8
+
9
+
type response = {sent: bool} [@@deriving yojson {strict= false}]
10
+
11
+
let handler =
12
+
Xrpc.handler ~auth:Admin (fun {req; db; _} ->
13
+
let%lwt {recipient_did; content; subject; sender_did; comment= _} =
14
+
Xrpc.parse_body req request_of_yojson
15
+
in
16
+
match%lwt Data_store.get_actor_by_identifier recipient_did db with
17
+
| None ->
18
+
Errors.invalid_request "recipient account not found"
19
+
| Some recipient -> (
20
+
match%lwt Data_store.get_actor_by_identifier sender_did db with
21
+
| None ->
22
+
Errors.invalid_request "sender account not found"
23
+
| Some sender ->
24
+
let subject =
25
+
Option.value subject
26
+
~default:
27
+
(Printf.sprintf "Message from %s via %s" sender.handle
28
+
Env.hostname )
29
+
in
30
+
let%lwt () =
31
+
Util.send_email_or_log ~recipients:[To recipient.email] ~subject
32
+
~body:(Plain content)
33
+
in
34
+
Dream.json @@ Yojson.Safe.to_string
35
+
@@ response_to_yojson {sent= true} ) )
+13
pegasus/lib/api/admin/updateAccountEmail.ml
+13
pegasus/lib/api/admin/updateAccountEmail.ml
···
1
+
type request = {account: string; email: string}
2
+
[@@deriving yojson {strict= false}]
3
+
4
+
let handler =
5
+
Xrpc.handler ~auth:Admin (fun {req; db; _} ->
6
+
let%lwt {account; email} = Xrpc.parse_body req request_of_yojson in
7
+
match%lwt Data_store.get_actor_by_identifier account db with
8
+
| None ->
9
+
Errors.invalid_request "account not found"
10
+
| Some actor ->
11
+
let email = String.lowercase_ascii email in
12
+
let%lwt () = Data_store.update_email ~did:actor.did ~email db in
13
+
Dream.empty `OK )
+14
pegasus/lib/api/admin/updateAccountHandle.ml
+14
pegasus/lib/api/admin/updateAccountHandle.ml
···
1
+
type request = {did: string; handle: string} [@@deriving yojson {strict= false}]
2
+
3
+
let handler =
4
+
Xrpc.handler ~auth:Admin (fun {req; db; _} ->
5
+
let%lwt {did; handle} = Xrpc.parse_body req request_of_yojson in
6
+
match%lwt Data_store.get_actor_by_identifier did db with
7
+
| None ->
8
+
Errors.invalid_request "account not found"
9
+
| Some _ -> (
10
+
match%lwt Identity.UpdateHandle.update_handle ~did ~handle db with
11
+
| Ok () ->
12
+
Dream.empty `OK
13
+
| Error e ->
14
+
Errors.invalid_request ~name:"InvalidHandle" e ) )
+2
-2
pegasus/lib/api/identity/updateHandle.ml
+2
-2
pegasus/lib/api/identity/updateHandle.ml
···
8
8
match%lwt Data_store.get_actor_by_identifier handle db with
9
9
| Some _ ->
10
10
Lwt.return_error "handle already in use"
11
-
| None ->
11
+
| None -> (
12
12
let%lwt () = Data_store.update_actor_handle ~did ~handle db in
13
13
let%lwt plc_result =
14
14
if String.starts_with ~prefix:"did:plc:" did then
···
52
52
| Ok () ->
53
53
let () = Ttl_cache.String_cache.remove Id_resolver.Did.cache did in
54
54
let%lwt _ = Sequencer.sequence_identity db ~did ~handle () in
55
-
Lwt.return_ok () )
55
+
Lwt.return_ok () ) )
56
56
57
57
let handler =
58
58
Xrpc.handler ~auth:Authorization (fun {req; auth; db; _} ->
+13
pegasus/lib/data_store.ml
+13
pegasus/lib/data_store.ml
···
123
123
RETURNING @int{remaining}
124
124
|sql}]
125
125
126
+
let list_invites =
127
+
[%rapper
128
+
get_many
129
+
{sql| SELECT @string{code}, @string{did}, @int{remaining}
130
+
FROM invite_codes
131
+
ORDER BY code ASC
132
+
LIMIT %int{limit}
133
+
|sql}
134
+
record_out]
135
+
126
136
(* reserved keys *)
127
137
let create_reserved_key =
128
138
[%rapper
···
326
336
let get_invite ~code conn = Util.use_pool conn @@ Queries.get_invite ~code
327
337
328
338
let use_invite ~code conn = Util.use_pool conn @@ Queries.use_invite ~code
339
+
340
+
let list_invites ?(limit = 100) conn =
341
+
Util.use_pool conn @@ Queries.list_invites ~limit
329
342
330
343
(* reserved keys *)
331
344
let create_reserved_key ~key_did ~did ~private_key conn =