+1

dune-project

reviewed

··· 49 49 (re (>= 1.13.2)) 50 50 (safepass (>= 3.1)) 51 51 (timedesc (>= 3.1.0)) 52 52 + (uri (>= 4.4.0)) 52 53 (uuidm (>= 0.9.10)) 53 54 (yojson (>= 3.0.0)) 54 55 (lwt_ppx (>= 5.9.1))

+1

pegasus.opam

reviewed

··· 21 21 "re" {>= "1.13.2"} 22 22 "safepass" {>= "3.1"} 23 23 "timedesc" {>= "3.1.0"} 24 24 + "uri" {>= "4.4.0"} 24 25 "uuidm" {>= "0.9.10"} 25 26 "yojson" {>= "3.0.0"} 26 27 "lwt_ppx" {>= "5.9.1"}

+10 -3

pegasus/lib/api/oauth_/par.ml

reviewed

··· 12 12 let handler ~nonce_state = 13 13 Xrpc.handler (fun ctx -> 14 14 let%lwt proof = 15 15 - Oauth.Dpop.verify_dpop_proof ~nonce_state ~mthd:"POST" ~url:"/oauth/par" 15 15 + Oauth.Dpop.verify_dpop_proof ~nonce_state 16 16 + ~mthd:(Dream.method_to_string @@ Dream.method_ ctx.req) 17 17 + ~url:(Dream.target ctx.req) 16 18 ~dpop_header:(Dream.header ctx.req "DPoP") 17 19 () 18 20 in ··· 26 28 Errors.invalid_request e 27 29 | Ok proof -> 28 30 let%lwt req = Xrpc.parse_body ctx.req request_of_yojson in 29 29 - let%lwt client = Oauth.Client.fetch_client_metadata req.client_id in 31 31 + let%lwt client = 32 32 + try%lwt Oauth.Client.fetch_client_metadata req.client_id 33 33 + with e -> 34 34 + Errors.log_exn ~req:ctx.req e ; 35 35 + Errors.invalid_request "failed to fetch client metadata" 36 36 + in 30 37 if req.response_type <> "code" then 31 38 Errors.invalid_request "only response_type=code supported" 32 39 else if req.code_challenge_method <> "S256" then 33 33 - Errors.invalid_request "only S256 code_challenge_method supported" 40 40 + Errors.invalid_request "only code_challenge_method=S256 supported" 34 41 else if not (List.mem req.redirect_uri client.redirect_uris) then 35 42 Errors.invalid_request "invalid redirect_uri" 36 43 else

+1 -2

pegasus/lib/api/well_known.ml

reviewed

··· 49 49 , `List [`String "query"; `String "fragment"] ) 50 50 ; ( "grant_types_supported" 51 51 , `List [`String "authorization_code"; `String "refresh_token"] ) 52 52 - ; ( "code_challenge_methods_supported" 53 53 - , `List [`String "S256"; `String "plain"] ) 52 52 + ; ("code_challenge_methods_supported", `List [`String "S256"]) 54 53 ; ("ui_locales_supported", `List [`String "en-US"]) 55 54 ; ( "display_values_supported" 56 55 , `List [`String "page"; `String "popup"; `String "touch"] )

+1 -2

pegasus/lib/auth.ml

reviewed

··· 169 169 Lwt.return_error @@ Errors.auth_required "missing authorization header" 170 170 | Ok token -> ( 171 171 let dpop_header = Dream.header req "DPoP" in 172 172 - let full_url = "https://" ^ Env.hostname ^ Dream.target req in 173 172 let%lwt dpop_result = 174 173 Oauth.Dpop.verify_dpop_proof ~nonce_state:!dpop_nonce_state 175 174 ~mthd:(Dream.method_to_string @@ Dream.method_ req) 176 176 - ~url:full_url ~dpop_header ~access_token:token () 175 175 + ~url:(Dream.target req) ~dpop_header ~access_token:token () 177 176 in 178 177 match dpop_result with 179 178 | Error e ->

+1

pegasus/lib/dune

reviewed

··· 18 18 safepass 19 19 str 20 20 timedesc 21 21 + uri 21 22 uuidm 22 23 yojson 23 24 lwt_ppx

+2 -2

pegasus/lib/oauth/dpop.ml

reviewed

··· 71 71 let normalize_url url = 72 72 let uri = Uri.of_string url in 73 73 Uri.make ~scheme:"https" 74 74 - ~host:(Uri.host uri |> Option.get) 75 75 - ?port:(Uri.port uri) ~path:(Uri.path uri) () 74 74 + ~host:(Uri.host uri |> Option.value ~default:Env.hostname) 75 75 + ~path:(Uri.path uri) () 76 76 |> Uri.to_string 77 77 78 78 let compute_jwk_thumbprint jwk =