objective categorical abstract machine language personal data server
handle dpop auth method
+64
-20
+63
-5
pegasus/lib/auth.ml
+63
-5
pegasus/lib/auth.ml
···
140
140
| Error _ ->
141
141
Lwt.return_error @@ Errors.auth_required "Invalid authorization header"
142
142
143
-
let access : verifier =
143
+
let bearer : verifier =
144
144
fun {req; db} ->
145
145
match parse_bearer req with
146
146
| Ok jwt -> (
···
160
160
| Error _ ->
161
161
Lwt.return_error @@ Errors.auth_required "Invalid authorization header"
162
162
163
+
let oauth : verifier =
164
+
fun {req; db} ->
165
+
match Dream.header req "Authorization" with
166
+
| None ->
167
+
Lwt.return_error @@ Errors.auth_required "missing authorization header"
168
+
| Some auth ->
169
+
if String.starts_with ~prefix:"DPoP " auth then
170
+
let token = String.sub auth 5 (String.length auth - 5) in
171
+
let dpop_header = Dream.header req "DPoP" in
172
+
let full_url = "https://" ^ Env.hostname ^ Dream.target req in
173
+
let%lwt dpop_result =
174
+
Oauth.Dpop.verify_dpop_proof ~nonce_state:!dpop_nonce_state
175
+
~mthd:(Dream.method_to_string @@ Dream.method_ req)
176
+
~url:full_url ~dpop_header ~access_token:token ()
177
+
in
178
+
match dpop_result with
179
+
| Error e ->
180
+
Lwt.return_error @@ Errors.auth_required ("dpop: " ^ e)
181
+
| Ok proof -> (
182
+
match Jwt.decode_jwt token with
183
+
| Error e ->
184
+
Lwt.return_error @@ Errors.auth_required e
185
+
| Ok (_header, claims) -> (
186
+
let open Yojson.Safe.Util in
187
+
try
188
+
let did = claims |> member "sub" |> to_string in
189
+
let exp = claims |> member "exp" |> to_int in
190
+
let jkt_claim =
191
+
claims |> member "cnf" |> member "jkt" |> to_string
192
+
in
193
+
if jkt_claim <> proof.jkt then
194
+
Lwt.return_error @@ Errors.auth_required "dpop key mismatch"
195
+
else
196
+
let now = int_of_float (Unix.gettimeofday ()) in
197
+
if exp < now then
198
+
Lwt.return_error @@ Errors.auth_required "token expired"
199
+
else
200
+
match Jwt.verify_jwt token Env.jwt_key with
201
+
| Error e ->
202
+
Lwt.return_error @@ Errors.auth_required e
203
+
| Ok _ ->
204
+
Lwt.return_ok (Access {did})
205
+
with _ ->
206
+
Lwt.return_error
207
+
@@ Errors.auth_required "malformed JWT claims" ) )
208
+
else bearer {req; db}
209
+
163
210
let refresh : verifier =
164
211
fun {req; db} ->
165
212
match parse_bearer req with
···
189
236
| Some ("Basic" :: _) ->
190
237
admin ctx
191
238
| Some ("Bearer" :: _) ->
192
-
access ctx
239
+
bearer ctx
240
+
| Some ("DPoP" :: _) ->
241
+
oauth ctx
193
242
| _ ->
194
243
Lwt.return_error
195
244
@@ Errors.auth_required ~name:"InvalidToken"
···
198
247
let any : verifier =
199
248
fun ctx -> try authorization ctx with _ -> unauthenticated ctx
200
249
201
-
type t = Unauthenticated | Admin | Access | Refresh | Authorization | Any
250
+
type t =
251
+
| Unauthenticated
252
+
| Admin
253
+
| Bearer
254
+
| Oauth
255
+
| Refresh
256
+
| Authorization
257
+
| Any
202
258
203
259
let of_t = function
204
260
| Unauthenticated ->
205
261
unauthenticated
206
262
| Admin ->
207
263
admin
208
-
| Access ->
209
-
access
264
+
| Bearer ->
265
+
bearer
266
+
| Oauth ->
267
+
oauth
210
268
| Refresh ->
211
269
refresh
212
270
| Authorization ->
-14
pegasus/lib/jwt.ml
-14
pegasus/lib/jwt.ml
···
118
118
let exp = now_s + Defaults.service_token_exp in
119
119
let payload = service_jwt_to_yojson {iss= did; aud; lxm; exp} in
120
120
sign_jwt payload signing_key
121
-
122
-
let extract_claim claims key =
123
-
try
124
-
let open Yojson.Safe.Util in
125
-
let rec find_nested json keys =
126
-
match keys with
127
-
| [] ->
128
-
Some json
129
-
| k :: rest ->
130
-
find_nested (json |> member k) rest
131
-
in
132
-
let keys = String.split_on_char '.' key in
133
-
find_nested claims keys
134
-
with _ -> None
+1
-1
pegasus/lib/xrpc.ml
+1
-1
pegasus/lib/xrpc.ml
···
121
121
let service_proxy_middleware db inner_handler req =
122
122
match Dream.header req "atproto-proxy" with
123
123
| Some header ->
124
-
handler ~auth:Access (fun ctx -> service_proxy ctx header) {req; db}
124
+
handler ~auth:Authorization (fun ctx -> service_proxy ctx header) {req; db}
125
125
| None ->
126
126
inner_handler req
127
127