+3 -1

bin/main.ml

··· 13 13 ; ( get 14 14 , "/.well-known/oauth-authorization-server" 15 15 , Api.Well_known.oauth_authorization_server ) 16 16 + ; (* oauth *) 17 17 + (get, "/oauth/par", Api.Oauth_.Par.handler) 16 18 ; (* unauthed *) 17 19 ( get 18 20 , "/xrpc/com.atproto.server.describeServer" ··· 77 79 Dream.serve ~interface:"0.0.0.0" ~port:8008 78 80 @@ Dream.logger 79 81 @@ Xrpc.service_proxy_middleware db 80 80 - @@ Dream.router 82 82 + @@ Xrpc.dpop_middleware @@ Dream.router 81 83 @@ List.map 82 84 (fun (fn, path, handler) -> 83 85 fn path (fun req -> handler ({req; db} : Xrpc.init)) )

+4 -6

pegasus/lib/api/oauth_/par.ml

··· 9 9 ; login_hint: string option } 10 10 [@@deriving yojson] 11 11 12 12 - let handler ~nonce_state = 12 12 + let handler = 13 13 Xrpc.handler (fun ctx -> 14 14 - let%lwt proof = 15 15 - Oauth.Dpop.verify_dpop_proof ~nonce_state 14 14 + let proof = 15 15 + Oauth.Dpop.verify_dpop_proof 16 16 ~mthd:(Dream.method_to_string @@ Dream.method_ ctx.req) 17 17 ~url:(Dream.target ctx.req) 18 18 ~dpop_header:(Dream.header ctx.req "DPoP") ··· 20 20 in 21 21 match proof with 22 22 | Error "use_dpop_nonce" -> 23 23 - let nonce = Oauth.Dpop.next_nonce nonce_state in 24 24 - Dream.json ~status:`Bad_Request ~headers:[("DPoP-Nonce", nonce)] 23 23 + Dream.json ~status:`Bad_Request 25 24 @@ Yojson.Safe.to_string 26 25 @@ `Assoc [("error", `String "use_dpop_nonce")] 27 26 | Error e -> ··· 60 59 ; created_at= Util.now_ms () } 61 60 in 62 61 Dream.json ~status:`Created 63 63 - ~headers:[("DPoP-Nonce", Oauth.Dpop.next_nonce nonce_state)] 64 62 @@ Yojson.Safe.to_string 65 63 @@ `Assoc 66 64 [("request_uri", `String request_uri); ("expires_in", `Int 300)] )

+18 -21

pegasus/lib/auth.ml

··· 16 16 | Access of {did: string} 17 17 | Refresh of {did: string; jti: string} 18 18 19 19 - let dpop_nonce_state = ref (Oauth.Dpop.create_nonce_state Env.dpop_nonce_secret) 20 20 - 21 19 let verify_bearer_jwt t token expected_scope = 22 20 match Jwt.verify_jwt token Env.jwt_key with 23 21 | Error err -> ··· 97 95 Error "invalid authorization header" ) 98 96 | None -> 99 97 Error "missing authorization header" 98 98 + end 100 99 101 101 - let parse_basic req = 102 102 - match parse_header req "Basic" with 103 103 - | Ok token -> ( 104 104 - match Base64.decode token with 105 105 - | Ok decoded -> ( 106 106 - match Str.bounded_split (Str.regexp_string ":") decoded 2 with 107 107 - | [username; password] -> 108 108 - Ok (username, password) 109 109 - | _ -> 110 110 - Error "invalid basic authorization header" ) 111 111 - | Error _ -> 100 100 + let parse_basic req = 101 101 + match parse_header req "Basic" with 102 102 + | Ok token -> ( 103 103 + match Base64.decode token with 104 104 + | Ok decoded -> ( 105 105 + match Str.bounded_split (Str.regexp_string ":") decoded 2 with 106 106 + | [username; password] -> 107 107 + Ok (username, password) 108 108 + | _ -> 112 109 Error "invalid basic authorization header" ) 113 110 | Error _ -> 114 114 - Error "invalid basic authorization header" 111 111 + Error "invalid basic authorization header" ) 112 112 + | Error _ -> 113 113 + Error "invalid basic authorization header" 115 114 116 116 - let parse_bearer req = parse_header req "Bearer" 115 115 + let parse_bearer req = parse_header req "Bearer" 117 116 118 118 - let parse_dpop req = parse_header req "DPoP" 119 119 - end 117 117 + let parse_dpop req = parse_header req "DPoP" 120 118 121 119 type ctx = {req: Dream.request; db: Data_store.t} 122 120 ··· 169 167 Lwt.return_error @@ Errors.auth_required "missing authorization header" 170 168 | Ok token -> ( 171 169 let dpop_header = Dream.header req "DPoP" in 172 172 - let%lwt dpop_result = 173 173 - Oauth.Dpop.verify_dpop_proof ~nonce_state:!dpop_nonce_state 170 170 + match 171 171 + Oauth.Dpop.verify_dpop_proof 174 172 ~mthd:(Dream.method_to_string @@ Dream.method_ req) 175 173 ~url:(Dream.target req) ~dpop_header ~access_token:token () 176 176 - in 177 177 - match dpop_result with 174 174 + with 178 175 | Error e -> 179 176 Lwt.return_error @@ Errors.auth_required ("dpop: " ^ e) 180 177 | Ok proof -> (

+36 -33

pegasus/lib/oauth/dpop.ml

··· 41 41 ; next= compute_nonce secret (Int64.succ counter) 42 42 ; rotation_interval_ms= Constants.dpop_rotation_interval_ms } 43 43 44 44 - let next_nonce state = 44 44 + let nonce_state = ref (create_nonce_state Env.dpop_nonce_secret) 45 45 + 46 46 + let next_nonce () = 45 47 let now_counter = 46 48 Int64.div 47 49 (Int64.of_float (Unix.gettimeofday () *. 1000.)) 48 48 - state.rotation_interval_ms 50 50 + !nonce_state.rotation_interval_ms 49 51 in 50 50 - if now_counter <> state.counter then ( 51 51 - state.prev <- state.curr ; 52 52 - state.curr <- state.next ; 53 53 - state.next <- compute_nonce state.secret (Int64.succ now_counter) ; 54 54 - state.counter <- now_counter ) ; 55 55 - state.next 52 52 + if now_counter <> !nonce_state.counter then ( 53 53 + !nonce_state.prev <- !nonce_state.curr ; 54 54 + !nonce_state.curr <- !nonce_state.next ; 55 55 + !nonce_state.next <- 56 56 + compute_nonce !nonce_state.secret (Int64.succ now_counter) ; 57 57 + !nonce_state.counter <- now_counter ) ; 58 58 + !nonce_state.next 56 59 57 57 - let verify_nonce state nonce = 58 58 - let valid = nonce = state.prev || nonce = state.curr || nonce = state.next in 59 59 - next_nonce state |> ignore ; 60 60 - valid 60 60 + let verify_nonce nonce = 61 61 + let valid = 62 62 + nonce = !nonce_state.prev || nonce = !nonce_state.curr 63 63 + || nonce = !nonce_state.next 64 64 + in 65 65 + ignore next_nonce ; valid 61 66 62 67 let add_jti jti = 63 68 let expires_at = int_of_float (Unix.gettimeofday ()) + Constants.jti_ttl_s in ··· 111 116 | _ -> 112 117 false 113 118 114 114 - let verify_dpop_proof ~nonce_state ~mthd ~url ~dpop_header ?access_token () = 119 119 + let verify_dpop_proof ~mthd ~url ~dpop_header ?access_token () = 115 120 match dpop_header with 116 121 | None -> 117 117 - Lwt.return_error "missing dpop header" 122 122 + Error "missing dpop header" 118 123 | Some jwt -> ( 119 124 let open Yojson.Safe.Util in 120 125 match String.split_on_char '.' jwt with ··· 122 127 let header = Yojson.Safe.from_string (Jwt.b64_decode header_b64) in 123 128 let payload = Yojson.Safe.from_string (Jwt.b64_decode payload_b64) in 124 129 let typ = header |> member "typ" |> to_string in 125 125 - if typ <> "dpop+jwt" then Lwt.return_error "invalid typ in dpop proof" 130 130 + if typ <> "dpop+jwt" then Error "invalid typ in dpop proof" 126 131 else 127 132 let alg = header |> member "alg" |> to_string in 128 133 if alg <> "ES256" && alg <> "ES256K" then 129 129 - Lwt.return_error "only es256 and es256k supported for dpop" 134 134 + Error "only es256 and es256k supported for dpop" 130 135 else 131 136 let jwk = 132 137 header |> member "jwk" |> ec_jwk_of_yojson |> Result.get_ok ··· 141 146 | _ -> 142 147 false ) 143 148 then 144 144 - Lwt.return_error 149 149 + Error 145 150 (Printf.sprintf "algorithm %s doesn't match curve %s" alg 146 151 jwk.crv ) 147 152 else ··· 155 160 match nonce_claim with 156 161 (* error must be this string; see https://datatracker.ietf.org/doc/html/rfc9449#section-8 *) 157 162 | None -> 158 158 - Lwt.return_error "use_dpop_nonce" 159 159 - | Some n when not (verify_nonce nonce_state n) -> 160 160 - Lwt.return_error "use_dpop_nonce" 163 163 + Error "use_dpop_nonce" 164 164 + | Some n when not (verify_nonce n) -> 165 165 + Error "use_dpop_nonce" 161 166 | Some _ -> ( 162 162 - if htm <> mthd then Lwt.return_error "htm mismatch" 167 167 + if htm <> mthd then Error "htm mismatch" 163 168 else if 164 169 not (String.equal (normalize_url htu) (normalize_url url)) 165 165 - then Lwt.return_error "htu mismatch" 170 170 + then Error "htu mismatch" 166 171 else 167 172 let now = int_of_float (Unix.gettimeofday ()) in 168 173 if now - iat > Constants.max_dpop_age_s then 169 169 - Lwt.return_error "dpop proof too old" 170 170 - else if iat - now > 5 then 171 171 - Lwt.return_error "dpop proof in future" 174 174 + Error "dpop proof too old" 175 175 + else if iat - now > 5 then Error "dpop proof in future" 172 176 else if not (add_jti jti) then 173 173 - Lwt.return_error "dpop proof replay detected" 177 177 + Error "dpop proof replay detected" 174 178 else if not (verify_signature jwt jwk) then 175 175 - Lwt.return_error "invalid dpop signature" 179 179 + Error "invalid dpop signature" 176 180 else 177 181 let jkt = compute_jwk_thumbprint jwk in 178 182 (* verify ath if access token is provided *) ··· 187 191 |> Jwt.b64_encode ) 188 192 in 189 193 if Some expected_ath <> ath_claim then 190 190 - Lwt.return_error "ath mismatch" 191 191 - else Lwt.return_ok {jti; jkt; htm; htu} 194 194 + Error "ath mismatch" 195 195 + else Ok {jti; jkt; htm; htu} 192 196 | None -> 193 197 let ath_claim = 194 198 payload |> member "ath" |> to_string_option 195 199 in 196 200 if ath_claim <> None then 197 197 - Lwt.return_error 198 198 - "ath claim not allowed without access token" 199 199 - else Lwt.return_ok {jti; jkt; htm; htu} ) ) 201 201 + Error "ath claim not allowed without access token" 202 202 + else Ok {jti; jkt; htm; htu} ) ) 200 203 | _ -> 201 201 - Lwt.return_error "invalid dpop jwt" ) 204 204 + Error "invalid dpop jwt" )

+10

pegasus/lib/xrpc.ml

··· 125 125 | None -> 126 126 inner_handler req 127 127 128 128 + let dpop_middleware inner_handler req = 129 129 + let%lwt res = inner_handler req in 130 130 + match Auth.Verifiers.parse_dpop req with 131 131 + | Ok _ -> 132 132 + Dream.add_header res "DPoP-Nonce" (Oauth.Dpop.next_nonce ()) ; 133 133 + Dream.add_header res "Access-Control-Expose-Headers" "DPoP-Nonce" ; 134 134 + Lwt.return res 135 135 + | Error _ -> 136 136 + Lwt.return res 137 137 + 128 138 let resolve_repo_did ctx repo = 129 139 if String.starts_with ~prefix:"did:" repo then Lwt.return repo 130 140 else