ATProto OAuth: client, discovery, and session management
atproto-oauth: reflow comments and tighten interface docs
Mostly dune fmt wrapping on the Profile / Login / Discovery mlis, plus
minor doc-string tightening. No semantic change.
+140
-167
+2
-1
lib/atproto_oauth.ml
+2
-1
lib/atproto_oauth.ml
···
18
18
]
19
19
20
20
let validate_server ?auth_method (m : Oauth.Server.metadata) =
21
-
match Oauth.Server.missing m (required_server_capabilities ?auth_method ())
21
+
match
22
+
Oauth.Server.missing m (required_server_capabilities ?auth_method ())
22
23
with
23
24
| [] -> Ok ()
24
25
| missing -> Error missing
+40
-45
lib/atproto_oauth.mli
+40
-45
lib/atproto_oauth.mli
···
31
31
32
32
val required_server_capabilities :
33
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.
34
+
(** [required_server_capabilities ?auth_method ()] lists the capabilities an
35
+
authorization server MUST advertise for an ATProto client to engage with
36
+
it. [auth_method] defaults to ["none"] (public loopback CLI); pass
37
+
["private_key_jwt"] for confidential clients.
38
38
39
39
The list contains:
40
-
- {!Oauth.Server.Par_supported}, {!Oauth.Server.Par_required} —
41
-
PAR (RFC 9126) is mandatory.
40
+
- {!Oauth.Server.Par_supported}, {!Oauth.Server.Par_required} — PAR (RFC
41
+
9126) is mandatory.
42
42
- {!Oauth.Server.Code_challenge_method} ["S256"] — PKCE (RFC 7636).
43
43
- {!Oauth.Server.Dpop_alg} ["ES256"] — DPoP (RFC 9449).
44
44
- {!Oauth.Server.Grant_type} ["authorization_code"] and
···
52
52
?auth_method:string ->
53
53
Oauth.Server.metadata ->
54
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. *)
55
+
(** [validate_server ?auth_method m] is [Ok ()] when [m] advertises every
56
+
capability in [required_server_capabilities ?auth_method ()]; otherwise
57
+
[Error missing] listing every unmet requirement in one pass. *)
59
58
60
59
type resource_violation =
61
60
| Bearer_method_dpop_missing
···
69
68
?expected_issuer:string ->
70
69
Oauth.Resource.metadata ->
71
70
(unit, resource_violation list) result
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].
71
+
(** [validate_resource ?expected_issuer r] checks that the protected resource
72
+
advertises [DPoP] in [bearer_methods_supported] and that, when
73
+
[expected_issuer] is given, it appears in [authorization_servers].
76
74
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]. *)
75
+
{b Issuer comparison is exact-string.} Both RFC 8414 and the ATProto
76
+
profile treat AS issuer URLs as canonical; do not rely on trailing-slash
77
+
or case-folding equivalence. Callers that need tolerance should normalize
78
+
before passing [expected_issuer]. *)
81
79
end
82
80
83
81
(** {1:client Client metadata builders}
···
95
93
unit ->
96
94
Oauth.Client.t
97
95
(** [public_loopback ~client_id ~redirect_uris ()] is an ATProto-compliant
98
-
client metadata document for a public client using a loopback redirect
99
-
URI (CLIs). Sets:
96
+
client metadata document for a public client using a loopback redirect URI
97
+
(CLIs). Sets:
100
98
- [dpop_bound_access_tokens = true]
101
99
- [token_endpoint_auth_method = "none"]
102
100
- [application_type = "web"]
···
105
103
- [scope] defaulting to {!Profile.default_scope}.
106
104
107
105
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. *)
106
+
counter-intuitive for a CLI: the ATProto OAuth profile requires [web] for
107
+
every client regardless of form factor. Only [web] clients may use HTTPS
108
+
redirect URIs and published client metadata, which the profile mandates.
109
+
See the ATProto OAuth clients spec for the full rationale. *)
113
110
114
111
val confidential :
115
112
client_id:string ->
···
141
138
type t = {
142
139
did : Did.t;
143
140
handle : Atproto_handle.t option;
144
-
(** Cached at login. May be stale after a handle rotation;
145
-
{!did} is authoritative. *)
141
+
(** Cached at login. May be stale after a handle rotation; {!did} is
142
+
authoritative. *)
146
143
pds_url : string;
147
144
server : Oauth.Server.metadata;
148
145
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. *)
146
+
(** Opaque private keypair binding tokens to this client. Leaking the
147
+
private material lets an attacker replay the tokens. *)
152
148
access_token : string;
153
149
refresh_token : string option;
154
150
expires_at : float option; (** Absolute Unix timestamp. *)
155
151
scope : string;
156
152
}
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. *)
153
+
(** Record exposed so callers can construct sessions by copying fields out of
154
+
a {!Atproto_oauth_discovery.t} and an {!Oauth.token_response} without the
155
+
10-argument constructor dance. *)
160
156
161
157
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. *)
158
+
(** [is_expired ?leeway ~clock t] is [true] iff the access token has expired
159
+
(or will within [leeway] seconds — default 60). Returns [false] when no
160
+
expiry was advertised. *)
165
161
166
162
val refresh :
167
163
Requests.t ->
···
169
165
client_auth:Oauth.Client_auth.t ->
170
166
t ->
171
167
(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
+
(** [refresh http ~clock ~client_auth t] rotates the access token using the
169
+
stored [refresh_token] and [dpop_key], and returns a new session with the
170
+
updated tokens and [expires_at]. Uses {!Oauth.Flow.refresh_bound} under
171
+
the hood so the DPoP proof and [DPoP-Nonce] retry are handled
172
+
automatically.
177
173
178
-
Returns [Error _] if the session has no refresh token (caller
179
-
must re-authenticate). *)
174
+
Returns [Error _] if the session has no refresh token (caller must
175
+
re-authenticate). *)
180
176
181
177
val pp : t Fmt.t
182
-
(** [pp] prints a short summary; never reveals tokens or key material.
183
-
*)
178
+
(** [pp] prints a short summary; never reveals tokens or key material. *)
184
179
end
+15
-16
lib/discovery/atproto_oauth_discovery.mli
+15
-16
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; if
86
-
no service has that fragment id, falls back to the first service
87
-
whose [type_] list contains ["AtprotoPersonalDataServer"]. Returns
85
+
(** [pds_of_document d] is the [#atproto_pds] [serviceEndpoint] URL; if no
86
+
service has that fragment id, falls back to the first service whose [type_]
87
+
list contains ["AtprotoPersonalDataServer"]. Returns
88
88
[Error (Pds_service_missing _)] when neither is present.
89
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. *)
90
+
{b Security note.} The type-fallback trades strictness for compatibility
91
+
with DID documents that don't use the canonical fragment id. A malicious or
92
+
misconfigured document could carry [#atproto_pds] pointing at one host and
93
+
an [AtprotoPersonalDataServer] service pointing at another; this helper
94
+
picks the fragment id first, matching the behavior of the ATProto reference
95
+
implementations. Callers that require strict fragment-id presence should use
96
+
{!Did.Document.service_by_id} directly. *)
98
97
99
98
(** {1:oauth Oauth bridge} *)
100
99
101
100
val to_provider : t -> (Oauth.custom_provider, [ `Msg of string ]) result
102
101
(** [to_provider d] lifts [d]'s authorization server metadata into an
103
102
{!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.
103
+
[userinfo_url] is set to [d.pds_url ^ "/xrpc/com.atproto.server.getSession"]
104
+
and [uid_field] to ["did"], matching the ATProto XRPC server's own session
105
+
endpoint.
107
106
108
107
Fails with [`Msg _] when the server metadata's endpoints fail HTTPS
109
108
validation (see {!Oauth.provider_of_server}). *)
···
118
117
Atproto_oauth.Session.t
119
118
(** [session d ~dpop_key ~clock ~scope resp] builds an
120
119
{!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]
120
+
response, filling [did], [pds_url], [server] from [d]; [access_token] and
121
+
[refresh_token] from [resp]; and [expires_at] from [resp.expires_in]
123
122
relative to [clock]'s current time. *)
+1
-2
lib/discovery/test/test_atproto_oauth_discovery.ml
+1
-2
lib/discovery/test/test_atproto_oauth_discovery.ml
···
164
164
| Error (`Msg m) -> Alcotest.failf "expected Ok, got %s" m
165
165
| Ok cp ->
166
166
Alcotest.(check string)
167
-
"userinfo-url"
168
-
"https://bsky.social/xrpc/com.atproto.server.getSession"
167
+
"userinfo-url" "https://bsky.social/xrpc/com.atproto.server.getSession"
169
168
cp.userinfo_url;
170
169
Alcotest.(check string) "uid-field" "did" cp.uid_field
171
170
+40
-46
lib/login/atproto_oauth_login.ml
+40
-46
lib/login/atproto_oauth_login.ml
···
7
7
| Callback_error of { error : string; description : string option }
8
8
9
9
let pp_error ppf = function
10
-
| Discovery e ->
11
-
Fmt.pf ppf "discovery: %a" Atproto_oauth_discovery.pp_error e
10
+
| Discovery e -> Fmt.pf ppf "discovery: %a" Atproto_oauth_discovery.pp_error e
12
11
| Provider (`Msg m) -> Fmt.pf ppf "provider: %s" m
13
12
| Flow e -> Fmt.pf ppf "oauth flow: %a" Oauth.Flow.pp_error e
14
13
| State_mismatch { expected; received } ->
···
61
60
let qs = String.sub target (i + 1) (String.length target - i - 1) in
62
61
String.split_on_char '&' qs
63
62
|> List.filter_map (fun kv ->
64
-
match String.index_opt kv '=' with
65
-
| None -> None
66
-
| Some j ->
67
-
let k = String.sub kv 0 j in
68
-
let v = String.sub kv (j + 1) (String.length kv - j - 1) in
69
-
Some (k, percent_decode v))
63
+
match String.index_opt kv '=' with
64
+
| None -> None
65
+
| Some j ->
66
+
let k = String.sub kv 0 j in
67
+
let v = String.sub kv (j + 1) (String.length kv - j - 1) in
68
+
Some (k, percent_decode v))
70
69
71
70
(* ----- Loopback listener ----- *)
72
71
73
72
let response_body =
74
73
"<!doctype html><html><head><meta charset=utf-8><title>ATProto \
75
-
login</title></head><body style=\"font-family:sans-serif;max-width:40em;margin:2em auto;padding:1em\"><h1>Login \
76
-
complete</h1><p>You may close this tab and return to your \
77
-
terminal.</p></body></html>"
74
+
login</title></head><body \
75
+
style=\"font-family:sans-serif;max-width:40em;margin:2em \
76
+
auto;padding:1em\"><h1>Login complete</h1><p>You may close this tab and \
77
+
return to your terminal.</p></body></html>"
78
78
79
79
let write_response flow =
80
80
let body = response_body in
81
81
let headers =
82
82
Fmt.str
83
-
"HTTP/1.1 200 OK\r\nContent-Type: text/html; \
84
-
charset=utf-8\r\nContent-Length: %d\r\nConnection: close\r\n\r\n"
83
+
"HTTP/1.1 200 OK\r\n\
84
+
Content-Type: text/html; charset=utf-8\r\n\
85
+
Content-Length: %d\r\n\
86
+
Connection: close\r\n\
87
+
\r\n"
85
88
(String.length body)
86
89
in
87
90
Eio.Flow.copy_string (headers ^ body) flow
···
110
113
in
111
114
match accepted with
112
115
| Error `Timeout -> Error (Loopback_timeout timeout_s)
113
-
| Ok (flow, _) ->
116
+
| Ok (flow, _) -> (
114
117
let line_opt = read_request_line flow in
115
118
(try write_response flow with _ -> ());
116
119
(try Eio.Flow.shutdown flow `All with _ -> ());
117
-
(match line_opt with
118
-
| None ->
119
-
Error
120
-
(Callback_error
121
-
{
122
-
error = "empty_request";
123
-
description = Some "the browser did not send a request line";
124
-
})
125
-
| Some line ->
126
-
(match String.split_on_char ' ' line with
127
-
| [ _; target; _ ] -> Ok (parse_query target)
128
-
| _ ->
129
-
Error
130
-
(Callback_error
131
-
{
132
-
error = "bad_request_line";
133
-
description = Some line;
134
-
})))
120
+
match line_opt with
121
+
| None ->
122
+
Error
123
+
(Callback_error
124
+
{
125
+
error = "empty_request";
126
+
description = Some "the browser did not send a request line";
127
+
})
128
+
| Some line -> (
129
+
match String.split_on_char ' ' line with
130
+
| [ _; target; _ ] -> Ok (parse_query target)
131
+
| _ ->
132
+
Error
133
+
(Callback_error
134
+
{ error = "bad_request_line"; description = Some line })))
135
135
136
136
(* ----- Login ----- *)
137
137
138
138
let default_on_authz_url url =
139
-
Fmt.pr "Open the following URL in your browser to authorize:@.@. %s@.@."
140
-
url
139
+
Fmt.pr "Open the following URL in your browser to authorize:@.@. %s@.@." url
141
140
142
141
let extract_callback ~ctx params =
143
142
match List.assoc_opt "error" params with
···
145
144
let description = List.assoc_opt "error_description" params in
146
145
Error (Callback_error { error = err; description })
147
146
| None -> (
148
-
match List.assoc_opt "code" params, List.assoc_opt "state" params with
147
+
match (List.assoc_opt "code" params, List.assoc_opt "state" params) with
149
148
| None, _ ->
150
149
Error
151
150
(Callback_error
···
154
153
description = Some "callback had no 'code' parameter";
155
154
})
156
155
| Some _, received when received <> Some (Oauth.Flow.state ctx) ->
157
-
Error
158
-
(State_mismatch
159
-
{ expected = Oauth.Flow.state ctx; received })
156
+
Error (State_mismatch { expected = Oauth.Flow.state ctx; received })
160
157
| Some code, Some state -> Ok (code, state)
161
158
| Some _, None ->
162
159
Error
163
-
(State_mismatch
164
-
{ expected = Oauth.Flow.state ctx; received = None }))
160
+
(State_mismatch { expected = Oauth.Flow.state ctx; received = None })
161
+
)
165
162
166
163
let run_flow ~http ~provider ~client_auth ~dpop_key ~ctx ~code ~returned_state
167
164
~discovery ~handle ~clock ~scope =
···
175
172
(Atproto_oauth_discovery.session discovery ~handle ~dpop_key ~clock
176
173
~scope resp)
177
174
178
-
let login ~sw ~clock ~net ~http ~client_id ?verify_tls ?plc_registry
179
-
?(port = 0) ?(timeout_s = 180.0) ?scope
180
-
?(on_authz_url = default_on_authz_url) handle =
175
+
let login ~sw ~clock ~net ~http ~client_id ?verify_tls ?plc_registry ?(port = 0)
176
+
?(timeout_s = 180.0) ?scope ?(on_authz_url = default_on_authz_url) handle =
181
177
let scope =
182
-
match scope with
183
-
| Some s -> s
184
-
| None -> Atproto_oauth.Profile.default_scope
178
+
match scope with Some s -> s | None -> Atproto_oauth.Profile.default_scope
185
179
in
186
180
let ( let* ) = Result.bind in
187
181
let* discovery =
+31
-33
lib/login/atproto_oauth_login.mli
+31
-33
lib/login/atproto_oauth_login.mli
···
4
4
5
5
+ Resolve the handle and discover the PDS + AS metadata
6
6
({!Atproto_oauth_discovery.of_handle}).
7
-
+ Validate the AS advertises the ATProto-required capabilities
8
-
(already performed by discovery).
7
+
+ Validate the AS advertises the ATProto-required capabilities (already
8
+
performed by discovery).
9
9
+ Generate a fresh DPoP keypair.
10
10
+ Push the authorization parameters via PAR ({!Oauth.Par}).
11
-
+ Start a short-lived localhost listener, open the authorization
12
-
URL (caller-configurable), and wait for the OAuth callback.
11
+
+ Start a short-lived localhost listener, open the authorization URL
12
+
(caller-configurable), and wait for the OAuth callback.
13
13
+ Exchange the code for tokens with a DPoP proof
14
14
({!Oauth.Flow.complete_authz}).
15
15
+ Wrap the result in an {!Atproto_oauth.Session.t}.
16
16
17
-
This module is intended for public-client CLI usage. Confidential
18
-
clients need a different entry point (a future [login_confidential]
19
-
that takes a [Dpop.key] and a [private_key_jwt] [Oauth.Client_auth.t]
20
-
— the pieces will share most of the flow). *)
17
+
This module is intended for public-client CLI usage. Confidential clients
18
+
need a different entry point (a future [login_confidential] that takes a
19
+
[Dpop.key] and a [private_key_jwt] [Oauth.Client_auth.t] — the pieces will
20
+
share most of the flow). *)
21
21
22
22
(** {1:errors Errors} *)
23
23
24
24
type error =
25
25
| Discovery of Atproto_oauth_discovery.error
26
26
| Provider of [ `Msg of string ]
27
-
(** {!Oauth.provider_of_server} rejected the discovered AS
28
-
endpoints (typically an endpoint that isn't HTTPS). *)
27
+
(** {!Oauth.provider_of_server} rejected the discovered AS endpoints
28
+
(typically an endpoint that isn't HTTPS). *)
29
29
| Flow of Oauth.Flow.error
30
30
(** The authorization request or token exchange failed. *)
31
31
| State_mismatch of { expected : string; received : string option }
32
-
(** The [state] query parameter the AS redirected back with did not
33
-
match the one we generated, or was absent. A client-side CSRF
34
-
trip — the flow is aborted. *)
32
+
(** The [state] query parameter the AS redirected back with did not match
33
+
the one we generated, or was absent. A client-side CSRF trip — the
34
+
flow is aborted. *)
35
35
| Loopback_timeout of float
36
-
(** The caller's deadline elapsed before the browser hit the
37
-
callback URL. The float is the waited-seconds budget. *)
36
+
(** The caller's deadline elapsed before the browser hit the callback URL.
37
+
The float is the waited-seconds budget. *)
38
38
| Callback_error of { error : string; description : string option }
39
-
(** The AS redirected to the callback with an [error] query
40
-
parameter instead of [code] — the user denied consent, the
41
-
request was malformed, etc. *)
39
+
(** The AS redirected to the callback with an [error] query parameter
40
+
instead of [code] — the user denied consent, the request was
41
+
malformed, etc. *)
42
42
43
43
val pp_error : error Fmt.t
44
44
(** [pp_error] formats an error for humans. *)
···
59
59
?on_authz_url:(string -> unit) ->
60
60
Atproto_handle.t ->
61
61
(Atproto_oauth.Session.t, error) result
62
-
(** [login ~sw ~clock ~net ~http ~client_id handle] runs the full
63
-
public-client login flow.
62
+
(** [login ~sw ~clock ~net ~http ~client_id handle] runs the full public-client
63
+
login flow.
64
64
65
-
- [client_id] is the URL at which the client metadata document is
66
-
hosted. For CLI loopback clients the ATProto profile allows
67
-
[client_id] of the form
68
-
[http://localhost?scope=...&redirect_uri=...] where the metadata
69
-
is embedded in the query.
70
-
- [port] is the loopback listener port; [0] (default) picks an
71
-
ephemeral port. The chosen port is reflected in the computed
72
-
redirect URI.
73
-
- [timeout_s] is the maximum time the loopback listener waits for
74
-
the callback. Default 180 seconds.
65
+
- [client_id] is the URL at which the client metadata document is hosted.
66
+
For CLI loopback clients the ATProto profile allows [client_id] of the
67
+
form [http://localhost?scope=...&redirect_uri=...] where the metadata is
68
+
embedded in the query.
69
+
- [port] is the loopback listener port; [0] (default) picks an ephemeral
70
+
port. The chosen port is reflected in the computed redirect URI.
71
+
- [timeout_s] is the maximum time the loopback listener waits for the
72
+
callback. Default 180 seconds.
75
73
- [scope] defaults to {!Atproto_oauth.Profile.default_scope}.
76
-
- [on_authz_url] is invoked once with the authorization URL the
77
-
user must visit. Defaults to printing to stdout; CLIs can wire
78
-
this to a browser-open helper. *)
74
+
- [on_authz_url] is invoked once with the authorization URL the user must
75
+
visit. Defaults to printing to stdout; CLIs can wire this to a
76
+
browser-open helper. *)
+7
-22
lib/login/test/test_atproto_oauth_login.ml
+7
-22
lib/login/test/test_atproto_oauth_login.ml
···
22
22
Alcotest.(check bool)
23
23
"discovery" true
24
24
(contains ~needle:"discovery"
25
-
(pp
26
-
(Discovery
27
-
(Pds_service_missing (Did.of_string_exn "did:plc:abc")))));
25
+
(pp (Discovery (Pds_service_missing (Did.of_string_exn "did:plc:abc")))));
28
26
Alcotest.(check bool)
29
27
"provider" true
30
28
(contains ~needle:"provider" (pp (Provider (`Msg "not https"))));
31
29
Alcotest.(check bool)
32
30
"flow" true
33
31
(contains ~needle:"oauth"
34
-
(pp
35
-
(Flow (Oauth.Flow.Token_error (Oauth.Http_error 400)))));
32
+
(pp (Flow (Oauth.Flow.Token_error (Oauth.Http_error 400)))));
36
33
Alcotest.(check bool)
37
34
"state-mismatch" true
38
35
(contains ~needle:"state"
39
-
(pp
40
-
(State_mismatch
41
-
{ expected = "abc"; received = Some "xyz" })));
36
+
(pp (State_mismatch { expected = "abc"; received = Some "xyz" })));
42
37
Alcotest.(check bool)
43
38
"state-mismatch-value" true
44
39
(contains ~needle:"xyz"
45
-
(pp
46
-
(State_mismatch
47
-
{ expected = "abc"; received = Some "xyz" })));
40
+
(pp (State_mismatch { expected = "abc"; received = Some "xyz" })));
48
41
Alcotest.(check bool)
49
42
"state-mismatch-none" true
50
43
(contains ~needle:"<none>"
···
60
53
(contains ~needle:"access_denied"
61
54
(pp
62
55
(Callback_error
63
-
{
64
-
error = "access_denied";
65
-
description = Some "user refused";
66
-
})));
56
+
{ error = "access_denied"; description = Some "user refused" })));
67
57
Alcotest.(check bool)
68
58
"callback-error-description" true
69
59
(contains ~needle:"user refused"
70
60
(pp
71
61
(Callback_error
72
-
{
73
-
error = "access_denied";
74
-
description = Some "user refused";
75
-
})));
62
+
{ error = "access_denied"; description = Some "user refused" })));
76
63
(* Callback error without description must still render. *)
77
64
Alcotest.(check bool)
78
65
"callback-error-no-description" true
79
66
(contains ~needle:"invalid_request"
80
-
(pp
81
-
(Callback_error
82
-
{ error = "invalid_request"; description = None })))
67
+
(pp (Callback_error { error = "invalid_request"; description = None })))
83
68
84
69
let suite : string * unit Alcotest.test_case list =
85
70
( "atproto-oauth-login",
+4
-2
test/test_atproto_oauth.ml
+4
-2
test/test_atproto_oauth.ml
···
396
396
"has-handle" true
397
397
(contains ~needle:"alice.bsky.social" rendered);
398
398
Alcotest.(check bool)
399
-
"no-access-token" false (contains ~needle:"ACCESS" rendered);
399
+
"no-access-token" false
400
+
(contains ~needle:"ACCESS" rendered);
400
401
Alcotest.(check bool)
401
-
"no-refresh-token" false (contains ~needle:"REFRESH" rendered)
402
+
"no-refresh-token" false
403
+
(contains ~needle:"REFRESH" rendered)
402
404
403
405
(* ------------------------------------------------------------------------ *)
404
406