OAuth 2.0 authorization and token exchange
oauth: lift RFC 8414 + RFC 9728 discovery types out of atproto-oauth
The ATProto OAuth profile's discovery metadata types were spec-level
(RFC 8414 authorization-server metadata with the RFC 9126 PAR and RFC
9449 DPoP extensions, and RFC 9728 protected-resource metadata) with
zero ATProto-specific content. Move them where they belong:
- lib/resource.ml (Oauth.Resource.metadata) is RFC 9728.
- lib/server.ml (Oauth.Server.metadata) is RFC 8414 + PAR + DPoP.
Both carry a Json codec and a pp.
In the same commit: Oauth.Provider.custom is restructured so it
embeds a Server.metadata directly instead of duplicating nine of the
same URLs. Constructor custom_provider keeps its signature (and
builds a minimal Server.metadata under the hood); new helper
provider_of_server builds a custom provider from an already-parsed
discovery document. Access paths that used to be c.token_url now go
through c.server.token_endpoint. This is a breaking API change for
pattern-matching callers, in line with the earlier oauth.ml split.
ocaml-atproto-oauth shrinks to the error type for now; the
ATProto-specific pieces (handle resolution, DID:PLC key discovery,
confidential-client profile policy) will land in follow-ups.
93 oauth tests pass (including 3 resource + 4 server shape tests that
moved over).
+495
-36
+6
-4
lib/oauth.ml
+6
-4
lib/oauth.ml
···
2
2
3
3
(* Provider *)
4
4
5
+
module Resource = Resource
6
+
module Server = Server
7
+
5
8
type provider = Provider.t =
6
9
| Github
7
10
| Google
···
10
13
11
14
and custom_provider = Provider.custom = {
12
15
name : string;
13
-
authorize_url : string;
14
-
token_url : string;
16
+
uid_field : string;
15
17
userinfo_url : string;
16
-
uid_field : string;
17
-
par_endpoint : string option;
18
+
server : Server.metadata;
18
19
}
19
20
20
21
let custom_provider = Provider.custom_provider
22
+
let provider_of_server = Provider.of_server
21
23
let provider_name = Provider.name
22
24
let provider_slug = Provider.slug
23
25
let authorize_url = Provider.authorize_url
+88
-14
lib/oauth.mli
+88
-14
lib/oauth.mli
···
41
41
| Error e -> (* handle error *)
42
42
]} *)
43
43
44
+
(** {1:discovery Discovery metadata}
45
+
46
+
Two RFCs describe the well-known documents a client fetches to learn about a
47
+
resource server and its authorization server:
48
+
49
+
- {b RFC 9728}
50
+
({{:https://datatracker.ietf.org/doc/html/rfc9728} protected-resource
51
+
metadata}) at [/.well-known/oauth-protected-resource] -- describes the
52
+
resource server and names the authorization servers it trusts.
53
+
- {b RFC 8414}
54
+
({{:https://datatracker.ietf.org/doc/html/rfc8414} authorization-server
55
+
metadata}) at [/.well-known/oauth-authorization-server] -- describes the
56
+
authorization server's endpoints and capabilities, with PAR (RFC 9126) and
57
+
DPoP (RFC 9449) extensions. *)
58
+
59
+
module Resource : sig
60
+
type metadata = {
61
+
resource : string; (** Canonical URL of the protected resource. *)
62
+
authorization_servers : string list;
63
+
(** URLs of authorization servers this resource trusts. *)
64
+
scopes_supported : string list;
65
+
bearer_methods_supported : string list;
66
+
}
67
+
68
+
val json : metadata Json.codec
69
+
(** Codec. Missing optional arrays default to empty. *)
70
+
71
+
val pp : metadata Fmt.t
72
+
end
73
+
74
+
module Server : sig
75
+
type metadata = {
76
+
issuer : string; (** Canonical origin URL of the AS. *)
77
+
authorization_endpoint : string;
78
+
token_endpoint : string;
79
+
pushed_authorization_request_endpoint : string option; (** RFC 9126. *)
80
+
require_pushed_authorization_requests : bool;
81
+
(** When [true] the AS rejects plain authorization requests (RFC 9126).
82
+
*)
83
+
introspection_endpoint : string option;
84
+
revocation_endpoint : string option;
85
+
jwks_uri : string option;
86
+
response_types_supported : string list;
87
+
grant_types_supported : string list;
88
+
code_challenge_methods_supported : string list;
89
+
token_endpoint_auth_methods_supported : string list;
90
+
token_endpoint_auth_signing_alg_values_supported : string list;
91
+
scopes_supported : string list;
92
+
dpop_signing_alg_values_supported : string list; (** RFC 9449. *)
93
+
}
94
+
95
+
val json : metadata Json.codec
96
+
(** Codec. Missing optional arrays default to empty; missing
97
+
[require_pushed_authorization_requests] defaults to [false]. *)
98
+
99
+
val pp : metadata Fmt.t
100
+
end
101
+
44
102
(** {1:providers Providers} *)
45
103
46
104
(** Supported OAuth providers. The variant determines which endpoints are used
···
59
117
| Custom of custom_provider (** A custom OAuth 2.0 provider. *)
60
118
61
119
and custom_provider = private {
62
-
name : string;
63
-
authorize_url : string;
64
-
token_url : string;
65
-
userinfo_url : string;
120
+
name : string; (** Display / identity name. Not in the RFC 8414 metadata. *)
66
121
uid_field : string; (** JSON field containing the unique user identifier. *)
67
-
par_endpoint : string option;
68
-
(** Pushed Authorization Request endpoint, if the server advertises one
69
-
(RFC 9126). [None] means {!Par.push} will refuse to push for this
70
-
provider. *)
122
+
userinfo_url : string;
123
+
(** Userinfo endpoint URL. Not in RFC 8414 core (OIDC extension). *)
124
+
server : Server.metadata;
125
+
(** RFC 8414 server metadata, possibly fetched via
126
+
[/.well-known/oauth-authorization-server]. Carries the authorization
127
+
endpoint, token endpoint, PAR endpoint (RFC 9126), DPoP signing algs
128
+
(RFC 9449), and the rest of the discovery document. *)
71
129
}
72
130
(** Configuration for a custom OAuth provider not covered by the built-in
73
-
variants. The type is private -- use {!custom_provider} to construct values.
74
-
Fields are readable for pattern matching.
131
+
variants. The type is private -- use {!custom_provider} or
132
+
{!provider_of_server} to construct values. Fields are readable for pattern
133
+
matching.
75
134
76
135
{b Security}: All URLs must use HTTPS. Per
77
136
{{:https://datatracker.ietf.org/doc/html/rfc6749#section-3.1} RFC 6749
78
137
section 3.1} the authorization endpoint must use TLS, and per
79
138
{{:https://datatracker.ietf.org/doc/html/rfc6749#section-3.2} section 3.2}
80
-
the token endpoint must use TLS. Use {!custom_provider} to construct values
81
-
with HTTPS validation. *)
139
+
the token endpoint must use TLS. The constructors validate this. *)
82
140
83
141
val custom_provider :
84
142
name:string ->
···
90
148
unit ->
91
149
(custom_provider, [ `Msg of string ]) result
92
150
(** [custom_provider ~name ~authorize_url ~token_url ~userinfo_url ~uid_field
93
-
?par_endpoint ()] constructs a custom provider configuration after
94
-
validating that:
151
+
?par_endpoint ()] constructs a custom provider configuration from
152
+
hand-configured URLs. A minimal {!Server.metadata} is built internally;
153
+
other fields (scopes_supported, code_challenge_methods_supported, etc.) are
154
+
left empty. If you have a full discovery document, use {!provider_of_server}
155
+
instead.
156
+
157
+
Validates:
95
158
- All endpoint URLs (including [par_endpoint] if supplied) use HTTPS (RFC
96
159
6749 section 3.1-3.2, RFC 9126 section 2).
97
160
- The slug derived from [name] does not collide with a built-in provider
···
101
164
underscores, hyphens).
102
165
103
166
Returns [Error (`Msg reason)] if validation fails. *)
167
+
168
+
val provider_of_server :
169
+
?name:string ->
170
+
userinfo_url:string ->
171
+
uid_field:string ->
172
+
Server.metadata ->
173
+
(custom_provider, [ `Msg of string ]) result
174
+
(** [provider_of_server ?name ~userinfo_url ~uid_field server] constructs a
175
+
custom provider directly from a {!Server.metadata} (typically fetched via
176
+
[/.well-known/oauth-authorization-server]). [name] defaults to the issuer.
177
+
All endpoint URLs are HTTPS-validated. *)
104
178
105
179
val provider_name : provider -> string
106
180
(** [provider_name p] is the canonical provider identifier used for identity
+75
-17
lib/provider.ml
+75
-17
lib/provider.ml
···
1
-
(* Provider configuration and URL dispatch. *)
1
+
(* Provider configuration and URL dispatch. A custom provider carries an
2
+
RFC 8414 Server.metadata directly, plus the few extras that aren't
3
+
standardised there (display name, userinfo URL, uid field). *)
2
4
3
5
type t = Github | Google | Gitlab | Custom of custom
4
6
5
7
and custom = {
6
8
name : string;
7
-
authorize_url : string;
8
-
token_url : string;
9
+
uid_field : string;
9
10
userinfo_url : string;
10
-
uid_field : string;
11
-
par_endpoint : string option;
11
+
server : Server.metadata;
12
12
}
13
13
14
14
(* Sanitize a string for use as a URL path segment per RFC 3986 section 3.3:
···
61
61
|| c = '_' || c = '-')
62
62
s
63
63
64
+
(* Build a minimal Server.metadata from the required URLs and optional PAR
65
+
endpoint. Other fields (response_types_supported, etc.) stay empty;
66
+
callers constructing a provider from discovery get them filled in. *)
67
+
let server_of_fields ~authorize_url ~token_url ?par_endpoint () :
68
+
Server.metadata =
69
+
{
70
+
issuer = authorize_url;
71
+
authorization_endpoint = authorize_url;
72
+
token_endpoint = token_url;
73
+
pushed_authorization_request_endpoint = par_endpoint;
74
+
require_pushed_authorization_requests = false;
75
+
introspection_endpoint = None;
76
+
revocation_endpoint = None;
77
+
jwks_uri = None;
78
+
response_types_supported = [];
79
+
grant_types_supported = [];
80
+
code_challenge_methods_supported = [];
81
+
token_endpoint_auth_methods_supported = [];
82
+
token_endpoint_auth_signing_alg_values_supported = [];
83
+
scopes_supported = [];
84
+
dpop_signing_alg_values_supported = [];
85
+
}
86
+
64
87
let custom_provider ~name ~authorize_url ~token_url ~userinfo_url ~uid_field
65
88
?par_endpoint () =
66
89
if not (is_valid_json_field_name uid_field) then
···
91
114
par_check )
92
115
with
93
116
| Ok (), Ok (), Ok (), Ok () ->
94
-
Ok
95
-
{
96
-
name;
97
-
authorize_url;
98
-
token_url;
99
-
userinfo_url;
100
-
uid_field;
101
-
par_endpoint;
102
-
}
117
+
let server =
118
+
server_of_fields ~authorize_url ~token_url ?par_endpoint ()
119
+
in
120
+
Ok { name; uid_field; userinfo_url; server }
121
+
| (Error _ as e), _, _, _
122
+
| _, (Error _ as e), _, _
123
+
| _, _, (Error _ as e), _
124
+
| _, _, _, (Error _ as e) ->
125
+
e
126
+
127
+
(* Build a custom provider from a server metadata document, typically fetched
128
+
via /.well-known/oauth-authorization-server. All URLs in the metadata are
129
+
re-validated for HTTPS. *)
130
+
let of_server ?name ~userinfo_url ~uid_field (server : Server.metadata) =
131
+
let name = Option.value ~default:server.issuer name in
132
+
if not (is_valid_json_field_name uid_field) then
133
+
Error
134
+
(`Msg
135
+
(Fmt.str
136
+
"uid_field must be a non-empty alphanumeric JSON field name, got %S"
137
+
uid_field))
138
+
else
139
+
let slug = path_safe name in
140
+
if List.mem slug builtin_slugs then
141
+
Error
142
+
(`Msg
143
+
(Fmt.str
144
+
"custom provider name %S produces slug %S which collides with \
145
+
built-in provider"
146
+
name slug))
147
+
else
148
+
let par_check =
149
+
match server.pushed_authorization_request_endpoint with
150
+
| None -> Ok ()
151
+
| Some url -> require_https "pushed_authorization_request_endpoint" url
152
+
in
153
+
match
154
+
( require_https "authorization_endpoint" server.authorization_endpoint,
155
+
require_https "token_endpoint" server.token_endpoint,
156
+
require_https "userinfo_url" userinfo_url,
157
+
par_check )
158
+
with
159
+
| Ok (), Ok (), Ok (), Ok () ->
160
+
Ok { name; uid_field; userinfo_url; server }
103
161
| (Error _ as e), _, _, _
104
162
| _, (Error _ as e), _, _
105
163
| _, _, (Error _ as e), _
···
122
180
| Github -> "https://github.com/login/oauth/authorize"
123
181
| Google -> "https://accounts.google.com/o/oauth2/v2/auth"
124
182
| Gitlab -> "https://gitlab.com/oauth/authorize"
125
-
| Custom c -> c.authorize_url
183
+
| Custom c -> c.server.authorization_endpoint
126
184
127
185
let token_url = function
128
186
| Github -> "https://github.com/login/oauth/access_token"
129
187
| Google -> "https://oauth2.googleapis.com/token"
130
188
| Gitlab -> "https://gitlab.com/oauth/token"
131
-
| Custom c -> c.token_url
189
+
| Custom c -> c.server.token_endpoint
132
190
133
191
let userinfo_url = function
134
192
| Github -> "https://api.github.com/user"
···
144
202
145
203
let par_endpoint = function
146
204
| Github | Google | Gitlab -> None
147
-
| Custom c -> c.par_endpoint
205
+
| Custom c -> c.server.pushed_authorization_request_endpoint
+44
lib/resource.ml
+44
lib/resource.ml
···
1
+
(* Protected-resource metadata per RFC 9728:
2
+
/.well-known/oauth-protected-resource *)
3
+
4
+
type metadata = {
5
+
resource : string;
6
+
authorization_servers : string list;
7
+
scopes_supported : string list;
8
+
bearer_methods_supported : string list;
9
+
}
10
+
11
+
let opt_list = function [] -> None | xs -> Some xs
12
+
13
+
let json : metadata Json.codec =
14
+
let open Json.Codec in
15
+
Object.(
16
+
map ~kind:"ProtectedResource"
17
+
(fun
18
+
resource
19
+
authorization_servers
20
+
scopes_supported
21
+
bearer_methods_supported
22
+
:
23
+
metadata
24
+
->
25
+
{
26
+
resource;
27
+
authorization_servers = Option.value ~default:[] authorization_servers;
28
+
scopes_supported = Option.value ~default:[] scopes_supported;
29
+
bearer_methods_supported =
30
+
Option.value ~default:[] bearer_methods_supported;
31
+
})
32
+
|> member "resource" string ~enc:(fun (r : metadata) -> r.resource)
33
+
|> opt_member "authorization_servers" (list string)
34
+
~enc:(fun (r : metadata) -> opt_list r.authorization_servers)
35
+
|> opt_member "scopes_supported" (list string) ~enc:(fun (r : metadata) ->
36
+
opt_list r.scopes_supported)
37
+
|> opt_member "bearer_methods_supported" (list string)
38
+
~enc:(fun (r : metadata) -> opt_list r.bearer_methods_supported)
39
+
|> seal)
40
+
41
+
let pp ppf (t : metadata) =
42
+
Fmt.pf ppf "<ProtectedResource %s -> %a>" t.resource
43
+
Fmt.(list ~sep:comma string)
44
+
t.authorization_servers
+107
lib/server.ml
+107
lib/server.ml
···
1
+
(* Authorization-server metadata per RFC 8414 with the PAR (RFC 9126) and
2
+
DPoP (RFC 9449) extensions. Served at
3
+
/.well-known/oauth-authorization-server. *)
4
+
5
+
type metadata = {
6
+
issuer : string;
7
+
authorization_endpoint : string;
8
+
token_endpoint : string;
9
+
pushed_authorization_request_endpoint : string option;
10
+
require_pushed_authorization_requests : bool;
11
+
introspection_endpoint : string option;
12
+
revocation_endpoint : string option;
13
+
jwks_uri : string option;
14
+
response_types_supported : string list;
15
+
grant_types_supported : string list;
16
+
code_challenge_methods_supported : string list;
17
+
token_endpoint_auth_methods_supported : string list;
18
+
token_endpoint_auth_signing_alg_values_supported : string list;
19
+
scopes_supported : string list;
20
+
dpop_signing_alg_values_supported : string list;
21
+
}
22
+
23
+
let opt_list = function [] -> None | xs -> Some xs
24
+
25
+
let json : metadata Json.codec =
26
+
let open Json.Codec in
27
+
Object.(
28
+
map ~kind:"AuthorizationServer"
29
+
(fun
30
+
issuer
31
+
authorization_endpoint
32
+
token_endpoint
33
+
pushed_authorization_request_endpoint
34
+
require_pushed_authorization_requests
35
+
introspection_endpoint
36
+
revocation_endpoint
37
+
jwks_uri
38
+
response_types_supported
39
+
grant_types_supported
40
+
code_challenge_methods_supported
41
+
token_endpoint_auth_methods_supported
42
+
token_endpoint_auth_signing_alg_values_supported
43
+
scopes_supported
44
+
dpop_signing_alg_values_supported
45
+
:
46
+
metadata
47
+
->
48
+
{
49
+
issuer;
50
+
authorization_endpoint;
51
+
token_endpoint;
52
+
pushed_authorization_request_endpoint;
53
+
require_pushed_authorization_requests =
54
+
Option.value ~default:false require_pushed_authorization_requests;
55
+
introspection_endpoint;
56
+
revocation_endpoint;
57
+
jwks_uri;
58
+
response_types_supported =
59
+
Option.value ~default:[] response_types_supported;
60
+
grant_types_supported = Option.value ~default:[] grant_types_supported;
61
+
code_challenge_methods_supported =
62
+
Option.value ~default:[] code_challenge_methods_supported;
63
+
token_endpoint_auth_methods_supported =
64
+
Option.value ~default:[] token_endpoint_auth_methods_supported;
65
+
token_endpoint_auth_signing_alg_values_supported =
66
+
Option.value ~default:[]
67
+
token_endpoint_auth_signing_alg_values_supported;
68
+
scopes_supported = Option.value ~default:[] scopes_supported;
69
+
dpop_signing_alg_values_supported =
70
+
Option.value ~default:[] dpop_signing_alg_values_supported;
71
+
})
72
+
|> member "issuer" string ~enc:(fun (r : metadata) -> r.issuer)
73
+
|> member "authorization_endpoint" string ~enc:(fun (r : metadata) ->
74
+
r.authorization_endpoint)
75
+
|> member "token_endpoint" string ~enc:(fun (r : metadata) ->
76
+
r.token_endpoint)
77
+
|> opt_member "pushed_authorization_request_endpoint" string
78
+
~enc:(fun (r : metadata) -> r.pushed_authorization_request_endpoint)
79
+
|> opt_member "require_pushed_authorization_requests" bool
80
+
~enc:(fun (r : metadata) ->
81
+
if r.require_pushed_authorization_requests then Some true else None)
82
+
|> opt_member "introspection_endpoint" string ~enc:(fun (r : metadata) ->
83
+
r.introspection_endpoint)
84
+
|> opt_member "revocation_endpoint" string ~enc:(fun (r : metadata) ->
85
+
r.revocation_endpoint)
86
+
|> opt_member "jwks_uri" string ~enc:(fun (r : metadata) -> r.jwks_uri)
87
+
|> opt_member "response_types_supported" (list string)
88
+
~enc:(fun (r : metadata) -> opt_list r.response_types_supported)
89
+
|> opt_member "grant_types_supported" (list string)
90
+
~enc:(fun (r : metadata) -> opt_list r.grant_types_supported)
91
+
|> opt_member "code_challenge_methods_supported" (list string)
92
+
~enc:(fun (r : metadata) ->
93
+
opt_list r.code_challenge_methods_supported)
94
+
|> opt_member "token_endpoint_auth_methods_supported" (list string)
95
+
~enc:(fun (r : metadata) ->
96
+
opt_list r.token_endpoint_auth_methods_supported)
97
+
|> opt_member "token_endpoint_auth_signing_alg_values_supported"
98
+
(list string) ~enc:(fun (r : metadata) ->
99
+
opt_list r.token_endpoint_auth_signing_alg_values_supported)
100
+
|> opt_member "scopes_supported" (list string) ~enc:(fun (r : metadata) ->
101
+
opt_list r.scopes_supported)
102
+
|> opt_member "dpop_signing_alg_values_supported" (list string)
103
+
~enc:(fun (r : metadata) ->
104
+
opt_list r.dpop_signing_alg_values_supported)
105
+
|> seal)
106
+
107
+
let pp ppf (t : metadata) = Fmt.pf ppf "<AuthorizationServer %s>" t.issuer
+2
test/test.ml
+2
test/test.ml
+2
-1
test/test_par.ml
+2
-1
test/test_par.ml
···
81
81
with
82
82
| Ok c ->
83
83
Alcotest.(check (option string))
84
-
"par_endpoint" (Some "https://as.example/par") c.par_endpoint
84
+
"par_endpoint" (Some "https://as.example/par")
85
+
c.server.pushed_authorization_request_endpoint
85
86
| Error (`Msg msg) -> Alcotest.failf "unexpected error: %s" msg
86
87
87
88
let test_custom_provider_rejects_http_par_endpoint () =
+54
test/test_resource.ml
+54
test/test_resource.ml
···
1
+
(* RFC 9728 /.well-known/oauth-protected-resource shape tests. *)
2
+
3
+
let decode s = Json.of_string Oauth.Resource.json s
4
+
5
+
let ok name s k =
6
+
match decode s with
7
+
| Ok t -> k t
8
+
| Error e -> Alcotest.failf "%s: decode failed: %a" name Json.Error.pp e
9
+
10
+
let err name s =
11
+
match decode s with
12
+
| Ok _ -> Alcotest.failf "%s: expected decode error" name
13
+
| Error _ -> ()
14
+
15
+
let test_typical_shape () =
16
+
let json =
17
+
{|{
18
+
"resource": "https://bsky.social",
19
+
"authorization_servers": ["https://bsky.social"],
20
+
"scopes_supported": ["atproto", "transition:generic"],
21
+
"bearer_methods_supported": ["DPoP"]
22
+
}|}
23
+
in
24
+
ok "typical" json @@ fun t ->
25
+
Alcotest.(check string) "resource" "https://bsky.social" t.resource;
26
+
Alcotest.(check (list string))
27
+
"authorization_servers" [ "https://bsky.social" ] t.authorization_servers;
28
+
Alcotest.(check (list string))
29
+
"scopes_supported"
30
+
[ "atproto"; "transition:generic" ]
31
+
t.scopes_supported;
32
+
Alcotest.(check (list string))
33
+
"bearer_methods_supported" [ "DPoP" ] t.bearer_methods_supported
34
+
35
+
let test_minimal () =
36
+
(* Missing optional arrays default to empty, not fail. *)
37
+
let json = {|{"resource": "https://pds.example.com"}|} in
38
+
ok "minimal" json @@ fun t ->
39
+
Alcotest.(check string) "resource" "https://pds.example.com" t.resource;
40
+
Alcotest.(check (list string))
41
+
"authorization_servers-empty" [] t.authorization_servers;
42
+
Alcotest.(check (list string))
43
+
"bearer_methods_supported-empty" [] t.bearer_methods_supported
44
+
45
+
let test_missing_resource () =
46
+
err "no-resource" {|{"authorization_servers": ["https://as.example"]}|}
47
+
48
+
let suite =
49
+
( "resource",
50
+
[
51
+
Alcotest.test_case "typical shape" `Quick test_typical_shape;
52
+
Alcotest.test_case "minimal" `Quick test_minimal;
53
+
Alcotest.test_case "missing resource" `Quick test_missing_resource;
54
+
] )
+117
test/test_server.ml
+117
test/test_server.ml
···
1
+
(* RFC 8414 /.well-known/oauth-authorization-server shape tests, including
2
+
the RFC 9126 (PAR) and RFC 9449 (DPoP) extension fields. *)
3
+
4
+
let decode s = Json.of_string Oauth.Server.json s
5
+
6
+
let ok name s k =
7
+
match decode s with
8
+
| Ok t -> k t
9
+
| Error e -> Alcotest.failf "%s: decode failed: %a" name Json.Error.pp e
10
+
11
+
let err name s =
12
+
match decode s with
13
+
| Ok _ -> Alcotest.failf "%s: expected decode error" name
14
+
| Error _ -> ()
15
+
16
+
let test_full_document () =
17
+
let json =
18
+
{|{
19
+
"issuer": "https://bsky.social",
20
+
"authorization_endpoint": "https://bsky.social/oauth/authorize",
21
+
"token_endpoint": "https://bsky.social/oauth/token",
22
+
"pushed_authorization_request_endpoint": "https://bsky.social/oauth/par",
23
+
"require_pushed_authorization_requests": true,
24
+
"introspection_endpoint": "https://bsky.social/oauth/introspect",
25
+
"revocation_endpoint": "https://bsky.social/oauth/revoke",
26
+
"jwks_uri": "https://bsky.social/oauth/jwks",
27
+
"response_types_supported": ["code"],
28
+
"grant_types_supported": ["authorization_code", "refresh_token"],
29
+
"code_challenge_methods_supported": ["S256"],
30
+
"token_endpoint_auth_methods_supported": ["none", "private_key_jwt"],
31
+
"token_endpoint_auth_signing_alg_values_supported": ["ES256"],
32
+
"scopes_supported": ["atproto", "transition:generic"],
33
+
"dpop_signing_alg_values_supported": ["ES256"]
34
+
}|}
35
+
in
36
+
ok "full" json @@ fun t ->
37
+
Alcotest.(check string) "issuer" "https://bsky.social" t.issuer;
38
+
Alcotest.(check string)
39
+
"authorization_endpoint" "https://bsky.social/oauth/authorize"
40
+
t.authorization_endpoint;
41
+
Alcotest.(check string)
42
+
"token_endpoint" "https://bsky.social/oauth/token" t.token_endpoint;
43
+
Alcotest.(check (option string))
44
+
"par endpoint" (Some "https://bsky.social/oauth/par")
45
+
t.pushed_authorization_request_endpoint;
46
+
Alcotest.(check bool)
47
+
"require PAR" true t.require_pushed_authorization_requests;
48
+
Alcotest.(check (list string))
49
+
"S256" [ "S256" ] t.code_challenge_methods_supported;
50
+
Alcotest.(check (list string))
51
+
"DPoP algs" [ "ES256" ] t.dpop_signing_alg_values_supported;
52
+
Alcotest.(check (list string))
53
+
"scopes"
54
+
[ "atproto"; "transition:generic" ]
55
+
t.scopes_supported
56
+
57
+
let test_minimal () =
58
+
(* Only the three required fields. Missing optional booleans default to
59
+
false; missing arrays default to empty. *)
60
+
let json =
61
+
{|{
62
+
"issuer": "https://as.example.com",
63
+
"authorization_endpoint": "https://as.example.com/auth",
64
+
"token_endpoint": "https://as.example.com/token"
65
+
}|}
66
+
in
67
+
ok "minimal" json @@ fun t ->
68
+
Alcotest.(check string) "issuer" "https://as.example.com" t.issuer;
69
+
Alcotest.(check bool)
70
+
"par-not-required" false t.require_pushed_authorization_requests;
71
+
Alcotest.(check (option string))
72
+
"no-par-ep" None t.pushed_authorization_request_endpoint;
73
+
Alcotest.(check (list string))
74
+
"dpop-empty" [] t.dpop_signing_alg_values_supported
75
+
76
+
let test_missing_token_endpoint () =
77
+
err "no-token-endpoint"
78
+
{|{
79
+
"issuer": "https://as.example.com",
80
+
"authorization_endpoint": "https://as.example.com/auth"
81
+
}|}
82
+
83
+
let test_roundtrip () =
84
+
let json =
85
+
{|{
86
+
"issuer": "https://bsky.social",
87
+
"authorization_endpoint": "https://bsky.social/oauth/authorize",
88
+
"token_endpoint": "https://bsky.social/oauth/token",
89
+
"pushed_authorization_request_endpoint": "https://bsky.social/oauth/par",
90
+
"require_pushed_authorization_requests": true,
91
+
"code_challenge_methods_supported": ["S256"],
92
+
"dpop_signing_alg_values_supported": ["ES256"]
93
+
}|}
94
+
in
95
+
ok "roundtrip-1" json @@ fun t1 ->
96
+
let encoded = Json.to_string Oauth.Server.json t1 in
97
+
ok "roundtrip-2" encoded @@ fun t2 ->
98
+
Alcotest.(check string) "issuer" t1.issuer t2.issuer;
99
+
Alcotest.(check (option string))
100
+
"par" t1.pushed_authorization_request_endpoint
101
+
t2.pushed_authorization_request_endpoint;
102
+
Alcotest.(check bool)
103
+
"par-req" t1.require_pushed_authorization_requests
104
+
t2.require_pushed_authorization_requests;
105
+
Alcotest.(check (list string))
106
+
"dpop" t1.dpop_signing_alg_values_supported
107
+
t2.dpop_signing_alg_values_supported
108
+
109
+
let suite =
110
+
( "server",
111
+
[
112
+
Alcotest.test_case "full document" `Quick test_full_document;
113
+
Alcotest.test_case "minimal" `Quick test_minimal;
114
+
Alcotest.test_case "missing token_endpoint" `Quick
115
+
test_missing_token_endpoint;
116
+
Alcotest.test_case "roundtrip" `Quick test_roundtrip;
117
+
] )