json: rename mem -> member / finish -> seal across the codec + value API

+4 -3

dune-project

··· 19 19 (fmt (>= 0.9)) 20 20 (uri (>= 4.0)) 21 21 (json (>= 0.1.0)) 22 - (bytesrw (>= 0.1.0)) 23 22 (crypto-rng (>= 0.11.0)) 23 + (dpop (>= 0.1.0)) 24 24 (digestif (>= 1.0)) 25 25 (eio (>= 1.0)) 26 26 (base64 (>= 3.0)) ··· 30 30 (ohex (>= 0.2)) 31 31 (logs (>= 0.7)) 32 32 (alcotest :with-test) 33 - (crowbar :with-test) 34 - (odoc :with-doc))) 33 + (alcobar :with-test) 34 + (odoc :with-doc) 35 + loc))

+4 -4

fuzz/fuzz_oauth.ml

··· 30 30 Json.Codec.Object.map ~kind:"token_response" 31 31 (fun access_token expires_in refresh_token -> 32 32 (access_token, expires_in, refresh_token)) 33 - |> Json.Codec.Object.mem "access_token" Json.Codec.string 33 + |> Json.Codec.Object.member "access_token" Json.Codec.string 34 34 ~enc:(fun (at, _, _) -> at) 35 - |> Json.Codec.Object.opt_mem "expires_in" Json.Codec.int 35 + |> Json.Codec.Object.opt_member "expires_in" Json.Codec.int 36 36 ~enc:(fun (_, ei, _) -> ei) 37 - |> Json.Codec.Object.opt_mem "refresh_token" Json.Codec.string 37 + |> Json.Codec.Object.opt_member "refresh_token" Json.Codec.string 38 38 ~enc:(fun (_, _, rt) -> rt) 39 - |> Json.Codec.Object.finish 39 + |> Json.Codec.Object.seal 40 40 41 41 (* Restrict fuzzed bytes to printable ASCII so JSON encode/decode roundtrips 42 42 are lossless. JSON strings are Unicode; arbitrary bytes may not survive

+1

lib/dune

··· 6 6 json 7 7 crypto-rng 8 8 digestif 9 + dpop 9 10 base64 10 11 eio 11 12 eqaf

+166 -37

lib/oauth.ml

··· 383 383 refresh_token; 384 384 refresh_token_expires_in; 385 385 }) 386 - |> Object.mem "access_token" string ~enc:(fun t -> t.access_token) 387 - |> Object.opt_mem "token_type" string ~enc:(fun t -> t.token_type) 388 - |> Object.opt_mem "expires_in" int ~enc:(fun t -> t.expires_in) 389 - |> Object.opt_mem "refresh_token" string ~enc:(fun t -> t.refresh_token) 390 - |> Object.opt_mem "refresh_token_expires_in" int ~enc:(fun t -> 386 + |> Object.member "access_token" string ~enc:(fun t -> t.access_token) 387 + |> Object.opt_member "token_type" string ~enc:(fun t -> t.token_type) 388 + |> Object.opt_member "expires_in" int ~enc:(fun t -> t.expires_in) 389 + |> Object.opt_member "refresh_token" string ~enc:(fun t -> t.refresh_token) 390 + |> Object.opt_member "refresh_token_expires_in" int ~enc:(fun t -> 391 391 t.refresh_token_expires_in) 392 - |> Object.skip_unknown |> Object.finish 392 + |> Object.skip_unknown |> Object.seal 393 393 394 394 type parse_token_error = 395 395 | Invalid_json ··· 527 527 let open Json.Codec in 528 528 Object.map ~kind:"par_response" (fun request_uri expires_in -> 529 529 { request_uri; expires_in }) 530 - |> Object.mem "request_uri" string ~dec_absent:"" ~enc:(fun r -> 530 + |> Object.member "request_uri" string ~dec_absent:"" ~enc:(fun r -> 531 531 r.request_uri) 532 - |> Object.opt_mem "expires_in" int ~enc:(fun r -> r.expires_in) 533 - |> Object.skip_unknown |> Object.finish 532 + |> Object.opt_member "expires_in" int ~enc:(fun r -> r.expires_in) 533 + |> Object.skip_unknown |> Object.seal 534 534 535 535 let parse_response body = 536 536 match decode raw_jsont body with ··· 607 607 Uri.with_query uri q |> Uri.to_string 608 608 end 609 609 610 + (* -- DPoP-aware token endpoint POST (nonce retry) ----------------- *) 611 + 612 + (* Strip query and fragment from a URL for the DPoP htu claim. Dpop.proof 613 + already strips them, but we do it here too so the [htu] we pass to it 614 + matches the actual request target even if Dpop.proof ever changes. *) 615 + let htu_of_url url = 616 + let u = Uri.of_string url in 617 + Uri.with_query (Uri.with_fragment u None) [] |> Uri.to_string 618 + 619 + let post_form ?dpop_key ~htm url http ~extra_headers form_str = 620 + if not (Requests.verify_tls http) then 621 + invalid_arg 622 + "Oauth: Requests.t handle must have TLS certificate verification enabled"; 623 + let htu = htu_of_url url in 624 + let make_headers ?nonce () = 625 + let dpop_hdr = 626 + match dpop_key with 627 + | None -> [] 628 + | Some k -> [ ("DPoP", Dpop.proof k ~htm ~htu ?nonce ()) ] 629 + in 630 + Http.Headers.of_list (base_token_headers @ extra_headers @ dpop_hdr) 631 + in 632 + let send headers = 633 + let body = Requests.Body.text form_str in 634 + Requests.post http url ~body ~headers 635 + in 636 + let resp = send (make_headers ()) in 637 + let status = Requests.Response.status_code resp in 638 + if status >= 200 && status < 300 then Ok (Requests.Response.text resp) 639 + else 640 + (* RFC 9449 section 8: retry once if the server demands a DPoP nonce. *) 641 + match (dpop_key, Requests.Response.header_string "DPoP-Nonce" resp) with 642 + | Some _, Some nonce -> 643 + Log.info (fun m -> m "Retrying request to %s with DPoP nonce" url); 644 + let resp = send (make_headers ~nonce ()) in 645 + let status = Requests.Response.status_code resp in 646 + if status >= 200 && status < 300 then Ok (Requests.Response.text resp) 647 + else Error status 648 + | _ -> 649 + Log.warn (fun m -> m "Token endpoint returned HTTP %d" status); 650 + Error status 651 + 652 + (* -- Flow (RFC 6749 + RFC 7636 + RFC 9126 + RFC 9449) ------------- *) 653 + 654 + module Flow = struct 655 + type ctx = { 656 + state : string; 657 + code_verifier : code_verifier; 658 + redirect_uri : redirect_uri; 659 + } 660 + 661 + let state c = c.state 662 + let code_verifier c = c.code_verifier 663 + 664 + type error = Par_error of Par.error | Token_error of parse_token_error 665 + 666 + let pp_error fmt = function 667 + | Par_error e -> Fmt.pf fmt "PAR: %a" Par.pp_error e 668 + | Token_error e -> Fmt.pf fmt "token: %a" pp_parse_token_error e 669 + 670 + let begin_authz http provider ~client_auth ~redirect_uri ~scope ?dpop_key 671 + ?use_par () = 672 + let state = generate_state () in 673 + let verifier = generate_code_verifier () in 674 + let challenge = code_challenge S256 verifier in 675 + let ctx = { state; code_verifier = verifier; redirect_uri } in 676 + let par_available = par_endpoint_of provider <> None in 677 + let do_par = match use_par with Some b -> b | None -> par_available in 678 + if do_par then 679 + let dpop_proof = 680 + match dpop_key with 681 + | None -> None 682 + | Some k -> 683 + let htu = 684 + match par_endpoint_of provider with 685 + | Some u -> htu_of_url u 686 + | None -> "" 687 + in 688 + Some (Dpop.proof k ~htm:"POST" ~htu ()) 689 + in 690 + match 691 + Par.push http provider ~client_auth ~redirect_uri ~state ~scope 692 + ~code_challenge:challenge ~code_challenge_method:S256 ?dpop_proof () 693 + with 694 + | Error e -> Error (Par_error e) 695 + | Ok pr -> 696 + let client_id = Client_auth.client_id client_auth in 697 + let url = 698 + Par.authorization_url provider ~client_id 699 + ~request_uri:pr.request_uri 700 + in 701 + Ok (url, ctx) 702 + else 703 + let client_id = Client_auth.client_id client_auth in 704 + let url = 705 + authorization_url provider ~client_id ~redirect_uri ~state ~scope 706 + ~code_challenge:challenge ~code_challenge_method:S256 () 707 + in 708 + Ok (url, ctx) 709 + 710 + let complete_authz http provider ~client_auth ~ctx ~returned_state ~code 711 + ?dpop_key () = 712 + if not (validate_state ~expected:ctx.state ~actual:returned_state) then 713 + Error (Token_error (Http_error 400)) 714 + else 715 + let form_str, extra_headers = 716 + exchange_form_body ~client_auth ~code ~redirect_uri:ctx.redirect_uri 717 + ~code_verifier:ctx.code_verifier () 718 + in 719 + let url = token_url provider in 720 + match 721 + post_form ?dpop_key ~htm:"POST" url http ~extra_headers form_str 722 + with 723 + | Error status -> Error (Token_error (Http_error status)) 724 + | Ok body -> ( 725 + match parse_token_response body with 726 + | Ok _ as ok -> ok 727 + | Error e -> Error (Token_error e)) 728 + 729 + let refresh_bound http provider ~client_auth ~refresh_token ?dpop_key () = 730 + let form_str, extra_headers = 731 + refresh_form_body ~client_auth ~refresh_token 732 + in 733 + let url = token_url provider in 734 + match post_form ?dpop_key ~htm:"POST" url http ~extra_headers form_str with 735 + | Error status -> Error (Http_error status) 736 + | Ok body -> parse_token_response body 737 + end 738 + 610 739 (* -- Token Lifecycle ----------------------------------------------- *) 611 740 612 741 module Token = struct ··· 753 882 name; 754 883 avatar_url; 755 884 }) 756 - |> Object.mem "id" int ~enc:(fun _ -> 0) 757 - |> Object.mem "login" string ~dec_absent:"" ~enc:login 758 - |> Object.mem "email" string ~dec_absent:"" ~enc:(fun u -> 885 + |> Object.member "id" int ~enc:(fun _ -> 0) 886 + |> Object.member "login" string ~dec_absent:"" ~enc:login 887 + |> Object.member "email" string ~dec_absent:"" ~enc:(fun u -> 759 888 opt_to_string u.email) 760 - |> Object.mem "name" string ~dec_absent:"" ~enc:name 761 - |> Object.mem "avatar_url" string ~dec_absent:"" ~enc:avatar_url 762 - |> Object.skip_unknown |> Object.finish 889 + |> Object.member "name" string ~dec_absent:"" ~enc:name 890 + |> Object.member "avatar_url" string ~dec_absent:"" ~enc:avatar_url 891 + |> Object.skip_unknown |> Object.seal 763 892 764 893 (* Google OIDC: {"sub":"118...","email":"...","email_verified":true,"name":"...","picture":"..."} 765 894 Only populate email when email_verified is true. Track the verified flag. *) ··· 777 906 name; 778 907 avatar_url = picture; 779 908 }) 780 - |> Object.mem "sub" string ~enc:uid 781 - |> Object.mem "email" string ~dec_absent:"" ~enc:(fun u -> 909 + |> Object.member "sub" string ~enc:uid 910 + |> Object.member "email" string ~dec_absent:"" ~enc:(fun u -> 782 911 opt_to_string u.email) 783 - |> Object.opt_mem "email_verified" bool ~enc:(fun u -> 912 + |> Object.opt_member "email_verified" bool ~enc:(fun u -> 784 913 Some (email_verified u)) 785 - |> Object.mem "name" string ~dec_absent:"" ~enc:name 786 - |> Object.mem "picture" string ~dec_absent:"" ~enc:avatar_url 787 - |> Object.skip_unknown |> Object.finish 914 + |> Object.member "name" string ~dec_absent:"" ~enc:name 915 + |> Object.member "picture" string ~dec_absent:"" ~enc:avatar_url 916 + |> Object.skip_unknown |> Object.seal 788 917 789 918 (* GitLab: {"id":123,"username":"john","email":"...","confirmed_at":"2024-...", 790 919 "name":"...","avatar_url":"..."} ··· 802 931 name; 803 932 avatar_url; 804 933 }) 805 - |> Object.mem "id" int ~enc:(fun _ -> 0) 806 - |> Object.mem "username" string ~dec_absent:"" ~enc:login 807 - |> Object.mem "email" string ~dec_absent:"" ~enc:(fun u -> 934 + |> Object.member "id" int ~enc:(fun _ -> 0) 935 + |> Object.member "username" string ~dec_absent:"" ~enc:login 936 + |> Object.member "email" string ~dec_absent:"" ~enc:(fun u -> 808 937 opt_to_string u.email) 809 - |> Object.opt_mem "confirmed_at" string ~enc:(fun u -> 938 + |> Object.opt_member "confirmed_at" string ~enc:(fun u -> 810 939 if email_verified u then Some "" else None) 811 - |> Object.mem "name" string ~dec_absent:"" ~enc:name 812 - |> Object.mem "avatar_url" string ~dec_absent:"" ~enc:avatar_url 813 - |> Object.skip_unknown |> Object.finish 940 + |> Object.member "name" string ~dec_absent:"" ~enc:name 941 + |> Object.member "avatar_url" string ~dec_absent:"" ~enc:avatar_url 942 + |> Object.skip_unknown |> Object.seal 814 943 815 944 (* Custom: uid extracted from the configured uid_field. Parses the standard 816 945 OIDC email_verified claim (Section 5.1) when present. *) ··· 828 957 name; 829 958 avatar_url = ""; 830 959 }) 831 - |> Object.mem uid_field string ~enc:uid 832 - |> Object.mem "email" string ~dec_absent:"" ~enc:(fun u -> 960 + |> Object.member uid_field string ~enc:uid 961 + |> Object.member "email" string ~dec_absent:"" ~enc:(fun u -> 833 962 opt_to_string u.email) 834 - |> Object.opt_mem "email_verified" bool ~enc:(fun u -> 963 + |> Object.opt_member "email_verified" bool ~enc:(fun u -> 835 964 Some (email_verified u)) 836 - |> Object.mem "name" string ~dec_absent:"" ~enc:name 837 - |> Object.skip_unknown |> Object.finish 965 + |> Object.member "name" string ~dec_absent:"" ~enc:name 966 + |> Object.skip_unknown |> Object.seal 838 967 839 968 let err_userinfo_parse e = 840 969 Error ("userinfo parse error: " ^ Json.Error.to_string e) ··· 865 994 let open Json.Codec in 866 995 Object.map ~kind:"github_email" (fun email primary verified -> 867 996 { email; primary; verified }) 868 - |> Object.mem "email" string ~enc:(fun e -> e.email) 869 - |> Object.mem "primary" bool ~enc:(fun e -> e.primary) 870 - |> Object.mem "verified" bool ~enc:(fun e -> e.verified) 871 - |> Object.skip_unknown |> Object.finish 997 + |> Object.member "email" string ~enc:(fun e -> e.email) 998 + |> Object.member "primary" bool ~enc:(fun e -> e.primary) 999 + |> Object.member "verified" bool ~enc:(fun e -> e.verified) 1000 + |> Object.skip_unknown |> Object.seal 872 1001 873 1002 let github_emails_jsont = Json.Codec.list github_email_jsont 874 1003

+83

lib/oauth.mli

··· 416 416 (** [parse_response body] parses a PAR server response. *) 417 417 end 418 418 419 + (** {1:flow High-level flow} 420 + 421 + [Oauth.Flow] is the minimal glue that ties together state + PKCE, an 422 + optional PAR push, and an optional DPoP proof with nonce-challenge retry 423 + (RFC 9449 section 8). Use it when you want the code flow "done right" 424 + without wiring each primitive yourself. Drop down to the individual 425 + primitives when you need finer control. *) 426 + 427 + module Flow : sig 428 + type ctx 429 + (** State carried between the authorization redirect and the callback. The 430 + caller stores it in the user's session and passes it back to 431 + {!complete_authz}. Contains the [state] and PKCE [code_verifier] it 432 + generated, plus the [redirect_uri] for the exchange. *) 433 + 434 + val state : ctx -> string 435 + (** [state c] is the CSRF state to be compared against the [state] query 436 + parameter on the callback. *) 437 + 438 + val code_verifier : ctx -> code_verifier 439 + (** [code_verifier c] is the PKCE verifier generated at {!begin_authz}. *) 440 + 441 + type error = Par_error of Par.error | Token_error of parse_token_error 442 + 443 + val pp_error : Format.formatter -> error -> unit 444 + 445 + val begin_authz : 446 + Requests.t -> 447 + provider -> 448 + client_auth:Client_auth.t -> 449 + redirect_uri:redirect_uri -> 450 + scope:string list -> 451 + ?dpop_key:Dpop.key -> 452 + ?use_par:bool -> 453 + unit -> 454 + (string * ctx, error) result 455 + (** [begin_authz http provider ~client_auth ~redirect_uri ~scope ?dpop_key 456 + ?use_par ()] generates state + PKCE, optionally pushes the request to the 457 + provider's PAR endpoint, and returns the authorization URL to redirect the 458 + user to plus the [ctx] for the callback. 459 + 460 + [use_par] defaults to [true] when the provider has a [par_endpoint] and 461 + [false] otherwise; set explicitly to override. If [use_par] is forced 462 + [true] but the provider has no PAR endpoint, returns 463 + [Error (Par_error No_par_endpoint)]. 464 + 465 + When [dpop_key] is supplied and PAR is used, a DPoP proof binding the PAR 466 + request to the key is sent in the [DPoP] header. *) 467 + 468 + val complete_authz : 469 + Requests.t -> 470 + provider -> 471 + client_auth:Client_auth.t -> 472 + ctx:ctx -> 473 + returned_state:string -> 474 + code:string -> 475 + ?dpop_key:Dpop.key -> 476 + unit -> 477 + (token_response, error) result 478 + (** [complete_authz http provider ~client_auth ~ctx ~returned_state ~code 479 + ?dpop_key ()] validates [returned_state] against the state stored in 480 + [ctx] and exchanges [code] for an access token. 481 + 482 + If [dpop_key] is supplied, the token request carries a DPoP proof and the 483 + library retries once if the server responds with a [DPoP-Nonce] challenge 484 + (RFC 9449 section 8). 485 + 486 + Returns [Error (Token_error (Http_error 400))] if the state validation 487 + fails; the [400] here means "client-side invariant violated". *) 488 + 489 + val refresh_bound : 490 + Requests.t -> 491 + provider -> 492 + client_auth:Client_auth.t -> 493 + refresh_token:string -> 494 + ?dpop_key:Dpop.key -> 495 + unit -> 496 + (token_response, parse_token_error) result 497 + (** [refresh_bound http provider ~client_auth ~refresh_token ?dpop_key ()] 498 + refreshes an access token, optionally including a DPoP proof. Retries once 499 + on a [DPoP-Nonce] challenge. *) 500 + end 501 + 419 502 (** {1:token_lifecycle Token Lifecycle} 420 503 421 504 A self-refreshing token wrapper. Holds an access token and (optional)

+3 -2

oauth.opam

··· 15 15 "fmt" {>= "0.9"} 16 16 "uri" {>= "4.0"} 17 17 "json" {>= "0.1.0"} 18 - "bytesrw" {>= "0.1.0"} 19 18 "crypto-rng" {>= "0.11.0"} 19 + "dpop" {>= "0.1.0"} 20 20 "digestif" {>= "1.0"} 21 21 "eio" {>= "1.0"} 22 22 "base64" {>= "3.0"} ··· 26 26 "ohex" {>= "0.2"} 27 27 "logs" {>= "0.7"} 28 28 "alcotest" {with-test} 29 - "crowbar" {with-test} 29 + "alcobar" {with-test} 30 30 "odoc" {with-doc} 31 + "loc" 31 32 ] 32 33 build: [ 33 34 ["dune" "subst"] {dev}

+1

test/test.ml

··· 9 9 Test_client_auth.suite; 10 10 Test_par.suite; 11 11 Test_parse_token_response.suite; 12 + Test_flow.suite; 12 13 Test_token.suite; 13 14 ]

+137

test/test_flow.ml

··· 1 + open Test_helpers 2 + 3 + let flow_error = Alcotest.testable Oauth.Flow.pp_error ( = ) 4 + 5 + (* ctx accessors don't cross the wire so they are testable without a 6 + mock server. *) 7 + 8 + let test_ctx_carries_state_and_verifier () = 9 + Eio_main.run @@ fun env -> 10 + Eio.Switch.run @@ fun sw -> 11 + let http = Requests.v ~sw env in 12 + (* Github has no par_endpoint so begin_authz succeeds without hitting the 13 + network. *) 14 + match 15 + Oauth.Flow.begin_authz http Oauth.Github 16 + ~client_auth:(Oauth.Client_auth.post ~client_id:"x" ~client_secret:"y") 17 + ~redirect_uri:(redir "https://example.com/cb") 18 + ~scope:[ "email" ] () 19 + with 20 + | Error e -> Alcotest.failf "begin_authz: %a" Oauth.Flow.pp_error e 21 + | Ok (_url, ctx) -> 22 + let state = Oauth.Flow.state ctx in 23 + Alcotest.(check bool) 24 + "state is 64 hex chars" true 25 + (String.length state = 64 26 + && String.for_all 27 + (fun c -> (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f')) 28 + state); 29 + let v = Oauth.code_verifier_to_string (Oauth.Flow.code_verifier ctx) in 30 + Alcotest.(check bool) "verifier 43 chars" true (String.length v = 43) 31 + 32 + let test_begin_authz_builds_url_with_pkce_challenge () = 33 + Eio_main.run @@ fun env -> 34 + Eio.Switch.run @@ fun sw -> 35 + let http = Requests.v ~sw env in 36 + match 37 + Oauth.Flow.begin_authz http Oauth.Google 38 + ~client_auth:(Oauth.Client_auth.post ~client_id:"cid" ~client_secret:"y") 39 + ~redirect_uri:(redir "https://example.com/cb") 40 + ~scope:[ "openid" ] () 41 + with 42 + | Error e -> Alcotest.failf "begin_authz: %a" Oauth.Flow.pp_error e 43 + | Ok (url, _ctx) -> 44 + let u = Uri.of_string url in 45 + Alcotest.(check (option string)) 46 + "S256" (Some "S256") 47 + (Uri.get_query_param u "code_challenge_method"); 48 + Alcotest.(check bool) 49 + "has code_challenge" true 50 + (Uri.get_query_param u "code_challenge" <> None); 51 + Alcotest.(check (option string)) 52 + "response_type=code" (Some "code") 53 + (Uri.get_query_param u "response_type") 54 + 55 + let test_complete_authz_rejects_state_mismatch () = 56 + Eio_main.run @@ fun env -> 57 + Eio.Switch.run @@ fun sw -> 58 + let http = Requests.v ~sw env in 59 + let client_auth = Oauth.Client_auth.post ~client_id:"x" ~client_secret:"y" in 60 + let redirect_uri = redir "https://example.com/cb" in 61 + match 62 + Oauth.Flow.begin_authz http Oauth.Github ~client_auth ~redirect_uri 63 + ~scope:[] () 64 + with 65 + | Error e -> Alcotest.failf "begin_authz: %a" Oauth.Flow.pp_error e 66 + | Ok (_url, ctx) -> 67 + let res = 68 + Oauth.Flow.complete_authz http Oauth.Github ~client_auth ~ctx 69 + ~returned_state:"tampered-state" ~code:"c" () 70 + in 71 + Alcotest.(check (result reject flow_error)) 72 + "state mismatch rejected" 73 + (Error (Oauth.Flow.Token_error (Oauth.Http_error 400))) res 74 + 75 + let test_use_par_forced_true_on_no_endpoint_fails () = 76 + Eio_main.run @@ fun env -> 77 + Eio.Switch.run @@ fun sw -> 78 + let http = Requests.v ~sw env in 79 + match 80 + Oauth.Flow.begin_authz http Oauth.Github 81 + ~client_auth:(Oauth.Client_auth.post ~client_id:"x" ~client_secret:"y") 82 + ~redirect_uri:(redir "https://example.com/cb") 83 + ~scope:[] ~use_par:true () 84 + with 85 + | Error (Oauth.Flow.Par_error Oauth.Par.No_par_endpoint) -> () 86 + | Error e -> Alcotest.failf "wrong error: %a" Oauth.Flow.pp_error e 87 + | Ok _ -> 88 + Alcotest.fail "expected error when forcing PAR on a provider without one" 89 + 90 + let test_use_par_forced_false_skips_par () = 91 + Eio_main.run @@ fun env -> 92 + Eio.Switch.run @@ fun sw -> 93 + let http = Requests.v ~sw env in 94 + (* Build a custom provider with a par_endpoint and then explicitly opt out: 95 + the returned URL should be the direct authorization URL, not a PAR 96 + request_uri URL. *) 97 + let provider = 98 + match 99 + Oauth.custom_provider ~name:"atp-test" 100 + ~authorize_url:"https://as.example/auth" 101 + ~token_url:"https://as.example/token" 102 + ~userinfo_url:"https://as.example/user" ~uid_field:"sub" 103 + ~par_endpoint:"https://as.example/par" () 104 + with 105 + | Ok p -> Oauth.Custom p 106 + | Error (`Msg m) -> Alcotest.failf "custom_provider: %s" m 107 + in 108 + match 109 + Oauth.Flow.begin_authz http provider 110 + ~client_auth:(Oauth.Client_auth.post ~client_id:"c" ~client_secret:"y") 111 + ~redirect_uri:(redir "https://example.com/cb") 112 + ~scope:[ "r" ] ~use_par:false () 113 + with 114 + | Error e -> Alcotest.failf "begin_authz: %a" Oauth.Flow.pp_error e 115 + | Ok (url, _ctx) -> 116 + let u = Uri.of_string url in 117 + Alcotest.(check (option string)) 118 + "request_uri not present" None 119 + (Uri.get_query_param u "request_uri"); 120 + Alcotest.(check (option string)) 121 + "scope is direct" (Some "r") 122 + (Uri.get_query_param u "scope") 123 + 124 + let suite = 125 + ( "flow", 126 + [ 127 + Alcotest.test_case "ctx carries state and verifier" `Quick 128 + test_ctx_carries_state_and_verifier; 129 + Alcotest.test_case "begin_authz builds URL with PKCE challenge" `Quick 130 + test_begin_authz_builds_url_with_pkce_challenge; 131 + Alcotest.test_case "complete_authz rejects state mismatch" `Quick 132 + test_complete_authz_rejects_state_mismatch; 133 + Alcotest.test_case "use_par:true without endpoint fails" `Quick 134 + test_use_par_forced_true_on_no_endpoint_fails; 135 + Alcotest.test_case "use_par:false skips PAR" `Quick 136 + test_use_par_forced_false_skips_par; 137 + ] )

Configure Feed

Configure Feed