objective categorical abstract machine language personal data server
Simplify handler auth syntax
+33
-19
+1
-1
bin/main.ml
+1
-1
bin/main.ml
···
56
56
; (get, "/xrpc/com.atproto.sync.listBlobs", Api.Sync.ListBlobs.handler)
57
57
; ( get
58
58
, "/xrpc/com.atproto.sync.subscribeRepos"
59
-
, Api.Server.SubscribeRepos.handler )
59
+
, Api.Sync.SubscribeRepos.handler )
60
60
; (* preferences *)
61
61
( get
62
62
, "/xrpc/com.atproto.actor.getPreferences"
+1
-1
pegasus/lib/api/actor/getPreferences.ml
+1
-1
pegasus/lib/api/actor/getPreferences.ml
+1
-1
pegasus/lib/api/actor/putPreferences.ml
+1
-1
pegasus/lib/api/actor/putPreferences.ml
+1
-1
pegasus/lib/api/identity/updateHandle.ml
+1
-1
pegasus/lib/api/identity/updateHandle.ml
···
1
1
type request = {handle: string} [@@deriving yojson]
2
2
3
3
let handler =
4
-
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun {req; auth; db} ->
4
+
Xrpc.handler ~auth:Authorization (fun {req; auth; db} ->
5
5
let did = Auth.get_authed_did_exn auth in
6
6
let%lwt body = Dream.body req in
7
7
let handle =
+1
-1
pegasus/lib/api/repo/applyWrites.ml
+1
-1
pegasus/lib/api/repo/applyWrites.ml
···
12
12
and res_commit = {cid: string; rev: string} [@@deriving yojson]
13
13
14
14
let handler =
15
-
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun ctx ->
15
+
Xrpc.handler ~auth:Authorization (fun ctx ->
16
16
let%lwt input = Xrpc.parse_body ctx.req request_of_yojson in
17
17
let%lwt did = Xrpc.resolve_repo_did_authed ctx input.repo in
18
18
let%lwt repo = Repository.load did in
+1
-1
pegasus/lib/api/repo/createRecord.ml
+1
-1
pegasus/lib/api/repo/createRecord.ml
···
18
18
and res_commit = {cid: string; rev: string} [@@deriving yojson]
19
19
20
20
let handler =
21
-
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun ctx ->
21
+
Xrpc.handler ~auth:Authorization (fun ctx ->
22
22
let%lwt input = Xrpc.parse_body ctx.req request_of_yojson in
23
23
let%lwt did = Xrpc.resolve_repo_did_authed ctx input.repo in
24
24
let%lwt repo = Repository.load did in
+1
-1
pegasus/lib/api/repo/deleteRecord.ml
+1
-1
pegasus/lib/api/repo/deleteRecord.ml
···
11
11
and res_commit = {cid: string; rev: string} [@@deriving yojson]
12
12
13
13
let handler =
14
-
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun ctx ->
14
+
Xrpc.handler ~auth:Authorization (fun ctx ->
15
15
let%lwt input = Xrpc.parse_body ctx.req request_of_yojson in
16
16
let%lwt did = Xrpc.resolve_repo_did_authed ctx input.repo in
17
17
let%lwt repo = Repository.load did in
+1
-1
pegasus/lib/api/repo/putRecord.ml
+1
-1
pegasus/lib/api/repo/putRecord.ml
···
18
18
and res_commit = {cid: string; rev: string} [@@deriving yojson]
19
19
20
20
let handler =
21
-
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun ctx ->
21
+
Xrpc.handler ~auth:Authorization (fun ctx ->
22
22
let%lwt input = Xrpc.parse_body ctx.req request_of_yojson in
23
23
let%lwt did = Xrpc.resolve_repo_did_authed ctx input.repo in
24
24
let%lwt repo = Repository.load did in
+1
-1
pegasus/lib/api/repo/uploadBlob.ml
+1
-1
pegasus/lib/api/repo/uploadBlob.ml
···
1
1
type response = {blob: Mist.Blob_ref.typed_json_ref} [@@deriving yojson]
2
2
3
3
let handler =
4
-
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun ctx ->
4
+
Xrpc.handler ~auth:Authorization (fun ctx ->
5
5
let did = Auth.get_authed_did_exn ctx.auth in
6
6
let mime_type =
7
7
Option.value ~default:"application/octet-stream"
+1
-1
pegasus/lib/api/server/createInviteCode.ml
+1
-1
pegasus/lib/api/server/createInviteCode.ml
+1
-1
pegasus/lib/api/server/deleteSession.ml
+1
-1
pegasus/lib/api/server/deleteSession.ml
+1
-1
pegasus/lib/api/server/getServiceAuth.ml
+1
-1
pegasus/lib/api/server/getServiceAuth.ml
···
1
1
type response = {token: string} [@@deriving yojson {strict= false}]
2
2
3
3
let handler =
4
-
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun {req; auth; db} ->
4
+
Xrpc.handler ~auth:Authorization (fun {req; auth; db} ->
5
5
let did = Auth.get_authed_did_exn auth in
6
6
let aud, lxm =
7
7
match (Dream.query req "aud", Dream.query req "lxm") with
+1
-1
pegasus/lib/api/server/getSession.ml
+1
-1
pegasus/lib/api/server/getSession.ml
···
1
1
type response = Auth.session_info
2
2
3
3
let handler =
4
-
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun {db; auth; _} ->
4
+
Xrpc.handler ~auth:Authorization (fun {db; auth; _} ->
5
5
let did = Auth.get_authed_did_exn auth in
6
6
let%lwt session = Auth.get_session_info did db in
7
7
Dream.json @@ Yojson.Safe.to_string @@ Auth.session_info_to_yojson session )
+1
-1
pegasus/lib/api/server/refreshSession.ml
+1
-1
pegasus/lib/api/server/refreshSession.ml
+16
pegasus/lib/auth.ml
+16
pegasus/lib/auth.ml
···
256
256
257
257
let any : verifier =
258
258
fun ctx -> try authorization ctx with _ -> unauthenticated ctx
259
+
260
+
type t = Unauthenticated | Admin | Access | Refresh | Authorization | Any
261
+
262
+
let of_t = function
263
+
| Unauthenticated ->
264
+
unauthenticated
265
+
| Admin ->
266
+
admin
267
+
| Access ->
268
+
access
269
+
| Refresh ->
270
+
refresh
271
+
| Authorization ->
272
+
authorization
273
+
| Any ->
274
+
any
259
275
end
+3
-5
pegasus/lib/xrpc.ml
+3
-5
pegasus/lib/xrpc.ml
···
7
7
8
8
type handler = context -> Dream.response Lwt.t
9
9
10
-
let handler ?(auth : Auth.Verifiers.verifier = Auth.Verifiers.any)
11
-
(hdlr : handler) (init : init) =
10
+
let handler ?(auth : Auth.Verifiers.t = Any) (hdlr : handler) (init : init) =
12
11
let open Errors in
12
+
let auth = Auth.Verifiers.of_t auth in
13
13
match%lwt auth init with
14
14
| Ok creds -> (
15
15
try%lwt hdlr {req= init.req; db= init.db; auth= creds}
···
118
118
let service_proxy_middleware db inner_handler req =
119
119
match Dream.header req "atproto-proxy" with
120
120
| Some header ->
121
-
handler ~auth:Auth.Verifiers.access
122
-
(fun ctx -> service_proxy ctx header)
123
-
{req; db}
121
+
handler ~auth:Access (fun ctx -> service_proxy ctx header) {req; db}
124
122
| None ->
125
123
inner_handler req
126
124