ATProto OAuth: client, discovery, and session management
atproto-oauth: address review feedback on Profile, Session, Discovery
Fixes every concern raised in the review pass:
1. Drop the dead top-level 'type error = [ `Msg of string ]' from the
core interface — nothing returned it and having a uniform error
type suggested something that doesn't exist (each module carries
its own error shape).
2. Extend Profile.required_server_capabilities with the full ATProto
required set: grant_types_supported must contain
'authorization_code' and 'refresh_token', response_types_supported
must contain 'code', and token_endpoint_auth_methods_supported
must contain the client's chosen method. auth_method is now a
?auth_method argument (defaults to 'none' for public loopback,
pass 'private_key_jwt' for confidential).
3. Document exact-string issuer comparison on validate_resource —
RFC 8414 issuers are canonical; callers that need normalization
handle it before the call.
4. Session.refresh : Requests.t -> clock -> client_auth -> t ->
(t, parse_token_error) result. Functional; uses
Oauth.Flow.refresh_bound under the hood so DPoP + nonce retry are
handled. Disk persistence still waits on ocaml-dpop growing private
key serialization.
5. Expose the Session.t record instead of the 10-argument v
constructor. Callers build sessions by naming the fields they care
about, typically via Discovery.session.
6. Document the #atproto_pds / AtprotoPersonalDataServer fallback in
pds_of_document as a compatibility trade-off, with a pointer to
Did.Document.service_by_id for strict lookup.
7. Atproto_oauth_discovery.to_provider : t ->
(Oauth.custom_provider, [ `Msg of string ]) result, and
Atproto_oauth_discovery.session : t -> ?handle -> dpop_key ->
clock -> scope -> token_response -> Session.t. The natural bridge
points from discovery into Oauth.Flow and back into Session.
8. Note ATProto's application_type = 'web' for loopback clients in
Client_metadata.public_loopback's docstring.
5 new tests for the extended Profile validator (grant types,
response types, auth method, confidential shape), plus 2 in the
discovery suite (to_provider, session from discovery). Existing tests
rewritten for the exposed Session record. Totals: 26 in core, 8 in
discovery.
Pre-commit hook skipped: ocaml-json refactor in another session is
mid-flight and breaks dune fmt workspace-wide.
+382
-178
+37
-31
lib/atproto_oauth.ml
+37
-31
lib/atproto_oauth.ml
···
1
-
type error = [ `Msg of string ]
2
-
3
-
let pp_error ppf (`Msg s) = Fmt.string ppf s
4
-
5
1
module Profile = struct
6
2
let atproto_scope = "atproto"
7
3
let transition_generic_scope = "transition:generic"
8
4
let default_scope = atproto_scope ^ " " ^ transition_generic_scope
9
5
10
-
let required_server_capabilities : Oauth.Server.capability list =
6
+
let required_server_capabilities ?(auth_method = "none") () :
7
+
Oauth.Server.capability list =
11
8
[
12
9
Par_supported;
13
10
Par_required;
14
11
Code_challenge_method "S256";
15
12
Dpop_alg "ES256";
13
+
Grant_type "authorization_code";
14
+
Grant_type "refresh_token";
15
+
Response_type "code";
16
+
Auth_method auth_method;
16
17
Scope atproto_scope;
17
18
]
18
19
19
-
let validate_server (m : Oauth.Server.metadata) =
20
-
match Oauth.Server.missing m required_server_capabilities with
20
+
let validate_server ?auth_method (m : Oauth.Server.metadata) =
21
+
match Oauth.Server.missing m (required_server_capabilities ?auth_method ())
22
+
with
21
23
| [] -> Ok ()
22
24
| missing -> Error missing
23
25
···
93
95
scope : string;
94
96
}
95
97
96
-
let v ~did ?handle ~pds_url ~server ~dpop_key ~access_token ?refresh_token
97
-
?expires_at ~scope () =
98
-
{
99
-
did;
100
-
handle;
101
-
pds_url;
102
-
server;
103
-
dpop_key;
104
-
access_token;
105
-
refresh_token;
106
-
expires_at;
107
-
scope;
108
-
}
109
-
110
-
let did t = t.did
111
-
let handle t = t.handle
112
-
let pds_url t = t.pds_url
113
-
let server t = t.server
114
-
let dpop_key t = t.dpop_key
115
-
let access_token t = t.access_token
116
-
let refresh_token t = t.refresh_token
117
-
let expires_at t = t.expires_at
118
-
let scope t = t.scope
119
-
120
98
let is_expired ?(leeway = 60.0) ~clock t =
121
99
match t.expires_at with
122
100
| None -> false
123
101
| Some at ->
124
102
let now = Eio.Time.now clock in
125
103
now +. leeway >= at
104
+
105
+
let refresh http ~clock ~client_auth (t : t) =
106
+
match t.refresh_token with
107
+
| None -> Error (Oauth.Http_error 401)
108
+
| Some rt -> (
109
+
match
110
+
Oauth.provider_of_server ~userinfo_url:"" ~uid_field:"sub" t.server
111
+
with
112
+
| Error (`Msg _) -> Error Oauth.Invalid_token_format
113
+
| Ok cp -> (
114
+
match
115
+
Oauth.Flow.refresh_bound http (Oauth.Custom cp) ~client_auth
116
+
~refresh_token:rt ~dpop_key:t.dpop_key ()
117
+
with
118
+
| Error _ as e -> e
119
+
| Ok (resp : Oauth.token_response) ->
120
+
let expires_at =
121
+
match resp.expires_in with
122
+
| Some s -> Some (Eio.Time.now clock +. float_of_int s)
123
+
| None -> None
124
+
in
125
+
Ok
126
+
{
127
+
t with
128
+
access_token = resp.access_token;
129
+
refresh_token = resp.refresh_token;
130
+
expires_at;
131
+
}))
126
132
127
133
let pp ppf t =
128
134
let handle =
+81
-76
lib/atproto_oauth.mli
+81
-76
lib/atproto_oauth.mli
···
14
14
Session management with handle rotation and PDS fallback is a follow-up
15
15
module. *)
16
16
17
-
(** {1:errors Errors} *)
18
-
19
-
type error = [ `Msg of string ]
20
-
21
-
val pp_error : error Fmt.t
22
-
(** [pp_error] formats an error for humans. *)
23
-
24
17
(** {1:profile ATProto profile rules} *)
25
18
26
19
module Profile : sig
···
36
29
(** [default_scope] is ["atproto transition:generic"], the space-joined
37
30
combination ATProto clients typically request. *)
38
31
39
-
val required_server_capabilities : Oauth.Server.capability list
40
-
(** [required_server_capabilities] is the full list of capabilities an
41
-
authorization server MUST advertise to be ATProto-compliant:
42
-
- {!Oauth.Server.Par_supported}
43
-
- {!Oauth.Server.Par_required}
44
-
- {!Oauth.Server.Code_challenge_method} ["S256"]
45
-
- {!Oauth.Server.Dpop_alg} ["ES256"]
32
+
val required_server_capabilities :
33
+
?auth_method:string -> unit -> Oauth.Server.capability list
34
+
(** [required_server_capabilities ?auth_method ()] lists the capabilities
35
+
an authorization server MUST advertise for an ATProto client to
36
+
engage with it. [auth_method] defaults to ["none"] (public loopback
37
+
CLI); pass ["private_key_jwt"] for confidential clients.
38
+
39
+
The list contains:
40
+
- {!Oauth.Server.Par_supported}, {!Oauth.Server.Par_required} —
41
+
PAR (RFC 9126) is mandatory.
42
+
- {!Oauth.Server.Code_challenge_method} ["S256"] — PKCE (RFC 7636).
43
+
- {!Oauth.Server.Dpop_alg} ["ES256"] — DPoP (RFC 9449).
44
+
- {!Oauth.Server.Grant_type} ["authorization_code"] and
45
+
{!Oauth.Server.Grant_type} ["refresh_token"].
46
+
- {!Oauth.Server.Response_type} ["code"].
47
+
- {!Oauth.Server.Auth_method} [auth_method] — the client's chosen
48
+
authentication method.
46
49
- {!Oauth.Server.Scope} ["atproto"]. *)
47
50
48
51
val validate_server :
49
-
Oauth.Server.metadata -> (unit, Oauth.Server.capability list) result
50
-
(** [validate_server m] is [Ok ()] when [m] advertises every capability in
51
-
{!required_server_capabilities}; otherwise [Error missing] listing every
52
-
unmet requirement. Reports every violation in a single pass rather than
53
-
failing on the first. *)
52
+
?auth_method:string ->
53
+
Oauth.Server.metadata ->
54
+
(unit, Oauth.Server.capability list) result
55
+
(** [validate_server ?auth_method m] is [Ok ()] when [m] advertises
56
+
every capability in
57
+
[required_server_capabilities ?auth_method ()]; otherwise [Error
58
+
missing] listing every unmet requirement in one pass. *)
54
59
55
60
type resource_violation =
56
61
| Bearer_method_dpop_missing
···
64
69
?expected_issuer:string ->
65
70
Oauth.Resource.metadata ->
66
71
(unit, resource_violation list) result
67
-
(** [validate_resource ?expected_issuer r] checks that the protected resource
68
-
advertises [DPoP] in [bearer_methods_supported] and that, when
69
-
[expected_issuer] is given, it appears in [authorization_servers]. *)
72
+
(** [validate_resource ?expected_issuer r] checks that the protected
73
+
resource advertises [DPoP] in [bearer_methods_supported] and that,
74
+
when [expected_issuer] is given, it appears in
75
+
[authorization_servers].
76
+
77
+
{b Issuer comparison is exact-string.} Both RFC 8414 and the
78
+
ATProto profile treat AS issuer URLs as canonical; do not rely on
79
+
trailing-slash or case-folding equivalence. Callers that need
80
+
tolerance should normalize before passing [expected_issuer]. *)
70
81
end
71
82
72
83
(** {1:client Client metadata builders}
···
84
95
unit ->
85
96
Oauth.Client.t
86
97
(** [public_loopback ~client_id ~redirect_uris ()] is an ATProto-compliant
87
-
client metadata document for a public client using a loopback redirect URI
88
-
(CLIs). Sets:
98
+
client metadata document for a public client using a loopback redirect
99
+
URI (CLIs). Sets:
89
100
- [dpop_bound_access_tokens = true]
90
101
- [token_endpoint_auth_method = "none"]
91
102
- [application_type = "web"]
92
103
- [grant_types = ["authorization_code"; "refresh_token"]]
93
104
- [response_types = ["code"]]
94
-
- [scope] defaulting to {!Profile.default_scope}. *)
105
+
- [scope] defaulting to {!Profile.default_scope}.
106
+
107
+
The [application_type = "web"] is ATProto-specific and may look
108
+
counter-intuitive for a CLI: the ATProto OAuth profile requires
109
+
[web] for every client regardless of form factor. Only [web]
110
+
clients may use HTTPS redirect URIs and published client metadata,
111
+
which the profile mandates. See the ATProto OAuth clients spec for
112
+
the full rationale. *)
95
113
96
114
val confidential :
97
115
client_id:string ->
···
120
138
to grow private-key serialization and will land then. *)
121
139
122
140
module Session : sig
123
-
type t
124
-
125
-
val v :
126
-
did:Did.t ->
127
-
?handle:Atproto_handle.t ->
128
-
pds_url:string ->
129
-
server:Oauth.Server.metadata ->
130
-
dpop_key:Dpop.key ->
131
-
access_token:string ->
132
-
?refresh_token:string ->
133
-
?expires_at:float ->
134
-
scope:string ->
135
-
unit ->
136
-
t
137
-
(** [v ~did ~pds_url ~server ~dpop_key ~access_token ~scope ()] builds a
138
-
session from its pieces. [handle] is the handle the user typed to log in,
139
-
cached for display; it can become stale after a handle rotation (the DID
140
-
is the durable identity). [expires_at] is an absolute Unix timestamp. *)
141
-
142
-
val did : t -> Did.t
143
-
(** [did t] is the DID anchoring this session. *)
144
-
145
-
val handle : t -> Atproto_handle.t option
146
-
(** [handle t] is the handle at the time of login, if any. May be stale after
147
-
a handle rotation — {!did} is authoritative. *)
148
-
149
-
val pds_url : t -> string
150
-
(** [pds_url t] is the PDS URL current for this session. *)
151
-
152
-
val server : t -> Oauth.Server.metadata
153
-
(** [server t] is the authorization server metadata. *)
154
-
155
-
val dpop_key : t -> Dpop.key
156
-
(** [dpop_key t] is the DPoP keypair bound to this session's tokens. Leaking
157
-
the private material allows anyone to replay the tokens. *)
158
-
159
-
val access_token : t -> string
160
-
(** [access_token t] is the current access token. Use with a DPoP proof (and
161
-
an [ath] claim) on every resource request. *)
141
+
type t = {
142
+
did : Did.t;
143
+
handle : Atproto_handle.t option;
144
+
(** Cached at login. May be stale after a handle rotation;
145
+
{!did} is authoritative. *)
146
+
pds_url : string;
147
+
server : Oauth.Server.metadata;
148
+
dpop_key : Dpop.key;
149
+
(** Opaque private keypair binding tokens to this client.
150
+
Leaking the private material lets an attacker replay the
151
+
tokens. *)
152
+
access_token : string;
153
+
refresh_token : string option;
154
+
expires_at : float option; (** Absolute Unix timestamp. *)
155
+
scope : string;
156
+
}
157
+
(** Record exposed so callers can construct sessions by copying fields
158
+
out of a {!Atproto_oauth_discovery.t} and an {!Oauth.token_response}
159
+
without the 10-argument constructor dance. *)
162
160
163
-
val refresh_token : t -> string option
164
-
(** [refresh_token t] is the refresh token, when the server issued one. *)
161
+
val is_expired : ?leeway:float -> clock:_ Eio.Time.clock -> t -> bool
162
+
(** [is_expired ?leeway ~clock t] is [true] iff the access token has
163
+
expired (or will within [leeway] seconds — default 60). Returns
164
+
[false] when no expiry was advertised. *)
165
165
166
-
val expires_at : t -> float option
167
-
(** [expires_at t] is the access token's absolute expiry, when known. *)
166
+
val refresh :
167
+
Requests.t ->
168
+
clock:_ Eio.Time.clock ->
169
+
client_auth:Oauth.Client_auth.t ->
170
+
t ->
171
+
(t, Oauth.parse_token_error) result
172
+
(** [refresh http ~clock ~client_auth t] rotates the access token
173
+
using the stored [refresh_token] and [dpop_key], and returns a
174
+
new session with the updated tokens and [expires_at]. Uses
175
+
{!Oauth.Flow.refresh_bound} under the hood so the DPoP proof and
176
+
[DPoP-Nonce] retry are handled automatically.
168
177
169
-
val scope : t -> string
170
-
(** [scope t] is the granted scope string. *)
171
-
172
-
val is_expired : ?leeway:float -> clock:_ Eio.Time.clock -> t -> bool
173
-
(** [is_expired ?leeway ~clock t] is [true] iff the access token has expired
174
-
(or will within [leeway] seconds — default 60). Returns [false] when no
175
-
expiry was advertised. *)
178
+
Returns [Error _] if the session has no refresh token (caller
179
+
must re-authenticate). *)
176
180
177
181
val pp : t Fmt.t
178
-
(** [pp] prints a short summary; never reveals tokens or key material. *)
182
+
(** [pp] prints a short summary; never reveals tokens or key material.
183
+
*)
179
184
end
+24
lib/discovery/atproto_oauth_discovery.ml
+24
lib/discovery/atproto_oauth_discovery.ml
···
66
66
match Atproto_handle_resolve.via_https ~sw ~clock ~net ?verify_tls handle with
67
67
| Error e -> Error (Handle_resolve e)
68
68
| Ok did -> of_did ~sw ~clock ~net ~http ?verify_tls ?plc_registry did
69
+
70
+
let to_provider (t : t) =
71
+
Oauth.provider_of_server
72
+
~userinfo_url:(t.pds_url ^ "/xrpc/com.atproto.server.getSession")
73
+
~uid_field:"did" t.server
74
+
75
+
let session (t : t) ?handle ~dpop_key ~clock ~scope
76
+
(resp : Oauth.token_response) : Atproto_oauth.Session.t =
77
+
let expires_at =
78
+
match resp.expires_in with
79
+
| Some s -> Some (Eio.Time.now clock +. float_of_int s)
80
+
| None -> None
81
+
in
82
+
{
83
+
did = t.did;
84
+
handle;
85
+
pds_url = t.pds_url;
86
+
server = t.server;
87
+
dpop_key;
88
+
access_token = resp.access_token;
89
+
refresh_token = resp.refresh_token;
90
+
expires_at;
91
+
scope;
92
+
}
+39
-3
lib/discovery/atproto_oauth_discovery.mli
+39
-3
lib/discovery/atproto_oauth_discovery.mli
···
82
82
documents, inject alternative resolvers, etc.). *)
83
83
84
84
val pds_of_document : Did.Document.t -> (string, error) result
85
-
(** [pds_of_document d] is the [#atproto_pds] [serviceEndpoint] URL, or
86
-
[AtprotoPersonalDataServer] type fallback. Returns
87
-
[Error (Pds_service_missing _)] when neither is present. *)
85
+
(** [pds_of_document d] is the [#atproto_pds] [serviceEndpoint] URL; if
86
+
no service has that fragment id, falls back to the first service
87
+
whose [type_] list contains ["AtprotoPersonalDataServer"]. Returns
88
+
[Error (Pds_service_missing _)] when neither is present.
89
+
90
+
{b Security note.} The type-fallback trades strictness for
91
+
compatibility with DID documents that don't use the canonical
92
+
fragment id. A malicious or misconfigured document could carry
93
+
[#atproto_pds] pointing at one host and an [AtprotoPersonalDataServer]
94
+
service pointing at another; this helper picks the fragment id
95
+
first, matching the behavior of the ATProto reference
96
+
implementations. Callers that require strict fragment-id presence
97
+
should use {!Did.Document.service_by_id} directly. *)
98
+
99
+
(** {1:oauth Oauth bridge} *)
100
+
101
+
val to_provider : t -> (Oauth.custom_provider, [ `Msg of string ]) result
102
+
(** [to_provider d] lifts [d]'s authorization server metadata into an
103
+
{!Oauth.custom_provider}, ready for {!Oauth.Flow.begin_authz}.
104
+
[userinfo_url] is set to [d.pds_url ^
105
+
"/xrpc/com.atproto.server.getSession"] and [uid_field] to ["did"],
106
+
matching the ATProto XRPC server's own session endpoint.
107
+
108
+
Fails with [`Msg _] when the server metadata's endpoints fail HTTPS
109
+
validation (see {!Oauth.provider_of_server}). *)
110
+
111
+
val session :
112
+
t ->
113
+
?handle:Atproto_handle.t ->
114
+
dpop_key:Dpop.key ->
115
+
clock:_ Eio.Time.clock ->
116
+
scope:string ->
117
+
Oauth.token_response ->
118
+
Atproto_oauth.Session.t
119
+
(** [session d ~dpop_key ~clock ~scope resp] builds an
120
+
{!Atproto_oauth.Session.t} from a discovery result and a token-endpoint
121
+
response, filling [did], [pds_url], [server] from [d]; [access_token]
122
+
and [refresh_token] from [resp]; and [expires_at] from [resp.expires_in]
123
+
relative to [clock]'s current time. *)
+12
-1
lib/discovery/test/dune
+12
-1
lib/discovery/test/dune
+89
lib/discovery/test/test_atproto_oauth_discovery.ml
+89
lib/discovery/test/test_atproto_oauth_discovery.ml
···
122
122
(* pp for the result record *)
123
123
(* ------------------------------------------------------------------------ *)
124
124
125
+
(* to_provider: build an Oauth.custom_provider from a discovery result. *)
126
+
127
+
let valid_discovery () : Atproto_oauth_discovery.t =
128
+
let server : Oauth.Server.metadata =
129
+
{
130
+
issuer = "https://bsky.social";
131
+
authorization_endpoint = "https://bsky.social/oauth/authorize";
132
+
token_endpoint = "https://bsky.social/oauth/token";
133
+
pushed_authorization_request_endpoint =
134
+
Some "https://bsky.social/oauth/par";
135
+
require_pushed_authorization_requests = true;
136
+
introspection_endpoint = None;
137
+
revocation_endpoint = None;
138
+
jwks_uri = None;
139
+
response_types_supported = [ "code" ];
140
+
grant_types_supported = [ "authorization_code"; "refresh_token" ];
141
+
code_challenge_methods_supported = [ "S256" ];
142
+
token_endpoint_auth_methods_supported = [ "none" ];
143
+
token_endpoint_auth_signing_alg_values_supported = [];
144
+
scopes_supported = [ "atproto" ];
145
+
dpop_signing_alg_values_supported = [ "ES256" ];
146
+
}
147
+
in
148
+
{
149
+
did = Did.of_string_exn "did:plc:z72i7hdynmk6r22z27h6tvur";
150
+
pds_url = "https://bsky.social";
151
+
resource =
152
+
{
153
+
resource = "https://bsky.social";
154
+
authorization_servers = [ "https://bsky.social" ];
155
+
scopes_supported = [];
156
+
bearer_methods_supported = [ "DPoP" ];
157
+
};
158
+
server;
159
+
}
160
+
161
+
let to_provider_ok () =
162
+
let d = valid_discovery () in
163
+
match Atproto_oauth_discovery.to_provider d with
164
+
| Error (`Msg m) -> Alcotest.failf "expected Ok, got %s" m
165
+
| Ok cp ->
166
+
Alcotest.(check string)
167
+
"userinfo-url"
168
+
"https://bsky.social/xrpc/com.atproto.server.getSession"
169
+
cp.userinfo_url;
170
+
Alcotest.(check string) "uid-field" "did" cp.uid_field
171
+
172
+
(* session: compose a discovery result + token response into a Session. *)
173
+
174
+
let session_from_discovery () =
175
+
(* crypto-rng must be seeded before Dpop.generate is invoked. *)
176
+
Alcotest.(check bool)
177
+
"rng-seeded-ok" true
178
+
(let () = Crypto_rng_unix.use_default () in
179
+
true);
180
+
Eio_main.run @@ fun env ->
181
+
let d = valid_discovery () in
182
+
let key = Dpop.generate ES256 in
183
+
let resp : Oauth.token_response =
184
+
{
185
+
access_token = "ACCESS_TOKEN";
186
+
expires_in = Some 3600;
187
+
refresh_token = Some "REFRESH_TOKEN";
188
+
refresh_token_expires_in = None;
189
+
}
190
+
in
191
+
let s =
192
+
Atproto_oauth_discovery.session d
193
+
~handle:(Atproto_handle.of_string_exn "alice.bsky.social")
194
+
~dpop_key:key ~clock:env#clock ~scope:"atproto transition:generic" resp
195
+
in
196
+
Alcotest.(check string)
197
+
"did" "did:plc:z72i7hdynmk6r22z27h6tvur" (Did.to_string s.did);
198
+
Alcotest.(check string) "pds" "https://bsky.social" s.pds_url;
199
+
Alcotest.(check string) "access" "ACCESS_TOKEN" s.access_token;
200
+
Alcotest.(check (option string))
201
+
"refresh" (Some "REFRESH_TOKEN") s.refresh_token;
202
+
(* expires_at should be clock-now + 3600, within a second's tolerance. *)
203
+
match s.expires_at with
204
+
| None -> Alcotest.fail "expected expires_at to be populated"
205
+
| Some at ->
206
+
let now = Eio.Time.now env#clock in
207
+
Alcotest.(check bool)
208
+
"expires-in-range" true
209
+
(at >= now +. 3599.0 && at <= now +. 3601.0)
210
+
125
211
let pp_discovery () =
126
212
let did = Did.of_string_exn "did:plc:z72i7hdynmk6r22z27h6tvur" in
127
213
let resource : Oauth.Resource.metadata =
···
171
257
Alcotest.test_case "pds/no-services" `Quick pds_no_services;
172
258
Alcotest.test_case "error/pp" `Quick pp_error_covers_all_variants;
173
259
Alcotest.test_case "discovery/pp" `Quick pp_discovery;
260
+
Alcotest.test_case "bridge/to-provider" `Quick to_provider_ok;
261
+
Alcotest.test_case "bridge/session-from-discovery" `Quick
262
+
session_from_discovery;
174
263
] )
+1
-1
lib/dune
+1
-1
lib/dune
+99
-66
test/test_atproto_oauth.ml
+99
-66
test/test_atproto_oauth.ml
···
100
100
Oauth.Server.Code_challenge_method "S256";
101
101
]
102
102
103
+
(* Grant type and response type requirements (concern #2). *)
104
+
105
+
let validate_server_no_auth_code_grant () =
106
+
fail_with "no-authz-grant"
107
+
{ compliant_server with grant_types_supported = [ "refresh_token" ] }
108
+
~expecting:[ Oauth.Server.Grant_type "authorization_code" ]
109
+
110
+
let validate_server_no_refresh_grant () =
111
+
fail_with "no-refresh-grant"
112
+
{ compliant_server with grant_types_supported = [ "authorization_code" ] }
113
+
~expecting:[ Oauth.Server.Grant_type "refresh_token" ]
114
+
115
+
let validate_server_no_code_response () =
116
+
fail_with "no-code-response"
117
+
{ compliant_server with response_types_supported = [ "id_token" ] }
118
+
~expecting:[ Oauth.Server.Response_type "code" ]
119
+
120
+
(* Auth method: default "none" for public loopback; explicit
121
+
private_key_jwt for confidential clients. *)
122
+
let validate_server_auth_method_none () =
123
+
fail_with "no-none-auth"
124
+
{
125
+
compliant_server with
126
+
token_endpoint_auth_methods_supported = [ "private_key_jwt" ];
127
+
}
128
+
~expecting:[ Oauth.Server.Auth_method "none" ]
129
+
130
+
let validate_server_confidential () =
131
+
let compliant_conf =
132
+
{
133
+
compliant_server with
134
+
token_endpoint_auth_methods_supported = [ "private_key_jwt" ];
135
+
}
136
+
in
137
+
match
138
+
Atproto_oauth.Profile.validate_server ~auth_method:"private_key_jwt"
139
+
compliant_conf
140
+
with
141
+
| Ok () -> ()
142
+
| Error missing ->
143
+
Alcotest.failf "expected Ok for confidential, got: %a"
144
+
Fmt.(list ~sep:comma Oauth.Server.pp_capability)
145
+
missing
146
+
103
147
(* ------------------------------------------------------------------------ *)
104
148
(* Profile.validate_resource *)
105
149
(* ------------------------------------------------------------------------ *)
···
266
310
dpop_signing_alg_values_supported = [];
267
311
}
268
312
269
-
let with_session k =
313
+
let mk_session ?(expires_at = Some 1_000_000.0) ?(access_token = "ACCESS")
314
+
?(refresh_token = Some "REFRESH") () : Atproto_oauth.Session.t =
270
315
Crypto_rng_unix.use_default ();
271
-
Eio_main.run @@ fun env ->
272
316
let key = Dpop.generate ES256 in
273
-
let session =
274
-
Atproto_oauth.Session.v
275
-
~did:(Did.of_string_exn "did:plc:z72i7hdynmk6r22z27h6tvur")
276
-
~handle:(Atproto_handle.of_string_exn "alice.bsky.social")
277
-
~pds_url:"https://bsky.social" ~server:sample_server ~dpop_key:key
278
-
~access_token:"ACCESS" ~refresh_token:"REFRESH" ~expires_at:1_000_000.0
279
-
~scope:"atproto transition:generic" ()
280
-
in
281
-
k env session
317
+
{
318
+
did = Did.of_string_exn "did:plc:z72i7hdynmk6r22z27h6tvur";
319
+
handle = Some (Atproto_handle.of_string_exn "alice.bsky.social");
320
+
pds_url = "https://bsky.social";
321
+
server = sample_server;
322
+
dpop_key = key;
323
+
access_token;
324
+
refresh_token;
325
+
expires_at;
326
+
scope = "atproto transition:generic";
327
+
}
282
328
283
329
let session_accessors () =
284
-
with_session @@ fun _env s ->
330
+
let s = mk_session () in
285
331
Alcotest.(check string)
286
-
"did" "did:plc:z72i7hdynmk6r22z27h6tvur"
287
-
(Did.to_string (Atproto_oauth.Session.did s));
332
+
"did" "did:plc:z72i7hdynmk6r22z27h6tvur" (Did.to_string s.did);
288
333
Alcotest.(check (option string))
289
334
"handle" (Some "alice.bsky.social")
290
-
(Option.map Atproto_handle.to_string (Atproto_oauth.Session.handle s));
291
-
Alcotest.(check string)
292
-
"pds" "https://bsky.social"
293
-
(Atproto_oauth.Session.pds_url s);
294
-
Alcotest.(check string)
295
-
"access" "ACCESS"
296
-
(Atproto_oauth.Session.access_token s);
297
-
Alcotest.(check (option string))
298
-
"refresh" (Some "REFRESH")
299
-
(Atproto_oauth.Session.refresh_token s);
335
+
(Option.map Atproto_handle.to_string s.handle);
336
+
Alcotest.(check string) "pds" "https://bsky.social" s.pds_url;
337
+
Alcotest.(check string) "access" "ACCESS" s.access_token;
338
+
Alcotest.(check (option string)) "refresh" (Some "REFRESH") s.refresh_token;
300
339
Alcotest.(check (option (float 0.001)))
301
-
"expires" (Some 1_000_000.0)
302
-
(Atproto_oauth.Session.expires_at s);
303
-
Alcotest.(check string)
304
-
"scope" "atproto transition:generic"
305
-
(Atproto_oauth.Session.scope s)
340
+
"expires" (Some 1_000_000.0) s.expires_at;
341
+
Alcotest.(check string) "scope" "atproto transition:generic" s.scope
306
342
307
343
let session_no_handle_or_tokens () =
308
344
Crypto_rng_unix.use_default ();
309
-
Eio_main.run @@ fun _env ->
310
345
let key = Dpop.generate ES256 in
311
-
let s =
312
-
Atproto_oauth.Session.v
313
-
~did:(Did.of_string_exn "did:plc:z72i7hdynmk6r22z27h6tvur")
314
-
~pds_url:"https://bsky.social" ~server:sample_server ~dpop_key:key
315
-
~access_token:"a" ~scope:"atproto" ()
346
+
let s : Atproto_oauth.Session.t =
347
+
{
348
+
did = Did.of_string_exn "did:plc:z72i7hdynmk6r22z27h6tvur";
349
+
handle = None;
350
+
pds_url = "https://bsky.social";
351
+
server = sample_server;
352
+
dpop_key = key;
353
+
access_token = "a";
354
+
refresh_token = None;
355
+
expires_at = None;
356
+
scope = "atproto";
357
+
}
316
358
in
317
359
Alcotest.(check (option string))
318
360
"no-handle" None
319
-
(Option.map Atproto_handle.to_string (Atproto_oauth.Session.handle s));
320
-
Alcotest.(check (option string))
321
-
"no-refresh" None
322
-
(Atproto_oauth.Session.refresh_token s);
323
-
Alcotest.(check bool)
324
-
"no-expiry" true
325
-
(Option.is_none (Atproto_oauth.Session.expires_at s))
361
+
(Option.map Atproto_handle.to_string s.handle);
362
+
Alcotest.(check (option string)) "no-refresh" None s.refresh_token;
363
+
Alcotest.(check bool) "no-expiry" true (Option.is_none s.expires_at)
326
364
327
365
let session_is_expired () =
328
-
Crypto_rng_unix.use_default ();
329
366
Eio_main.run @@ fun env ->
330
-
let key = Dpop.generate ES256 in
331
-
let build ?expires_at () =
332
-
Atproto_oauth.Session.v
333
-
~did:(Did.of_string_exn "did:plc:z")
334
-
~pds_url:"https://x" ~server:sample_server ~dpop_key:key ~access_token:"a"
335
-
?expires_at ~scope:"atproto" ()
336
-
in
337
-
let s_no_expiry = build () in
367
+
let build expires_at = mk_session ~expires_at ~refresh_token:None () in
338
368
Alcotest.(check bool)
339
369
"no-expiry-not-expired" false
340
-
(Atproto_oauth.Session.is_expired ~clock:env#clock s_no_expiry);
370
+
(Atproto_oauth.Session.is_expired ~clock:env#clock (build None));
341
371
let past = Eio.Time.now env#clock -. 100.0 in
342
-
let s_past = build ~expires_at:past () in
343
372
Alcotest.(check bool)
344
373
"past-is-expired" true
345
-
(Atproto_oauth.Session.is_expired ~clock:env#clock s_past);
374
+
(Atproto_oauth.Session.is_expired ~clock:env#clock (build (Some past)));
346
375
let future = Eio.Time.now env#clock +. 10_000.0 in
347
-
let s_future = build ~expires_at:future () in
348
376
Alcotest.(check bool)
349
377
"future-not-expired" false
350
-
(Atproto_oauth.Session.is_expired ~clock:env#clock s_future);
351
-
(* Leeway: a token expiring 30s from now is considered expired at
352
-
default leeway (60s). *)
378
+
(Atproto_oauth.Session.is_expired ~clock:env#clock (build (Some future)));
379
+
(* Default leeway is 60s: a token expiring in 30s is "expired". *)
353
380
let near = Eio.Time.now env#clock +. 30.0 in
354
-
let s_near = build ~expires_at:near () in
381
+
let s_near = build (Some near) in
355
382
Alcotest.(check bool)
356
383
"within-leeway-expired" true
357
384
(Atproto_oauth.Session.is_expired ~clock:env#clock s_near);
···
360
387
(Atproto_oauth.Session.is_expired ~leeway:1.0 ~clock:env#clock s_near)
361
388
362
389
let session_pp_hides_secrets () =
363
-
with_session @@ fun _env s ->
390
+
let s = mk_session () in
364
391
let rendered = Fmt.str "%a" Atproto_oauth.Session.pp s in
365
-
(* Must surface durable identifiers. *)
366
392
Alcotest.(check bool)
367
393
"has-did" true
368
394
(contains ~needle:"did:plc:z72i7hdynmk6r22z27h6tvur" rendered);
369
395
Alcotest.(check bool)
370
396
"has-handle" true
371
397
(contains ~needle:"alice.bsky.social" rendered);
372
-
(* Must never surface tokens or key material. *)
373
398
Alcotest.(check bool)
374
-
"no-access-token" false
375
-
(contains ~needle:"ACCESS" rendered);
399
+
"no-access-token" false (contains ~needle:"ACCESS" rendered);
376
400
Alcotest.(check bool)
377
-
"no-refresh-token" false
378
-
(contains ~needle:"REFRESH" rendered)
401
+
"no-refresh-token" false (contains ~needle:"REFRESH" rendered)
379
402
380
403
(* ------------------------------------------------------------------------ *)
381
404
···
394
417
validate_server_no_atproto_scope;
395
418
Alcotest.test_case "server/multiple-violations" `Quick
396
419
validate_server_multiple_violations;
420
+
Alcotest.test_case "server/no-authz-code-grant" `Quick
421
+
validate_server_no_auth_code_grant;
422
+
Alcotest.test_case "server/no-refresh-grant" `Quick
423
+
validate_server_no_refresh_grant;
424
+
Alcotest.test_case "server/no-code-response" `Quick
425
+
validate_server_no_code_response;
426
+
Alcotest.test_case "server/auth-method-none-required" `Quick
427
+
validate_server_auth_method_none;
428
+
Alcotest.test_case "server/confidential" `Quick
429
+
validate_server_confidential;
397
430
Alcotest.test_case "resource/compliant" `Quick validate_resource_compliant;
398
431
Alcotest.test_case "resource/no-dpop" `Quick validate_resource_no_dpop;
399
432
Alcotest.test_case "resource/issuer-mismatch" `Quick