ActivityPub in OCaml using jsont/eio/requests
fmt
+1890
-1372
+482
-314
bin/apub.ml
+482
-314
bin/apub.ml
···
20
20
21
21
let timeout =
22
22
let doc = "Request timeout in seconds." in
23
-
Arg.(value & opt float 30.0 & info ["timeout"; "t"] ~docv:"SECONDS" ~doc)
23
+
Arg.(value & opt float 30.0 & info [ "timeout"; "t" ] ~docv:"SECONDS" ~doc)
24
24
25
25
let user_agent =
26
26
let doc = "User-Agent header for HTTP requests." in
27
-
Arg.(value & opt string "apub/0.1" & info ["user-agent"; "A"] ~docv:"STRING" ~doc)
27
+
Arg.(
28
+
value & opt string "apub/0.1"
29
+
& info [ "user-agent"; "A" ] ~docv:"STRING" ~doc)
28
30
29
31
(* Webfinger command *)
30
32
module Webfinger_cmd = struct
31
33
let account =
32
-
let doc = "Account to look up (e.g., user@example.com or acct:user@example.com)." in
34
+
let doc =
35
+
"Account to look up (e.g., user@example.com or acct:user@example.com)."
36
+
in
33
37
Arg.(required & pos 0 (some string) None & info [] ~docv:"ACCOUNT" ~doc)
34
38
35
39
let json_output =
36
40
let doc = "Output raw JSON response." in
37
-
Arg.(value & flag & info ["json"; "j"] ~doc)
41
+
Arg.(value & flag & info [ "json"; "j" ] ~doc)
38
42
39
43
let run () timeout user_agent json_output account =
40
44
Eio_main.run @@ fun env ->
···
42
46
let client = Apubt.create ~sw ~user_agent ~timeout env in
43
47
try
44
48
let jrd = Apubt.Webfinger.lookup client account in
45
-
if json_output then begin
46
-
(try print_endline (Json.to_string Apubt.Proto.Webfinger.jsont jrd)
47
-
with Json.Error e -> Fmt.epr "JSON encoding error: %a@." Json.Error.pp e)
48
-
end else begin
49
+
if json_output then
50
+
begin try print_endline (Json.to_string Apubt.Proto.Webfinger.jsont jrd)
51
+
with Json.Error e ->
52
+
Fmt.epr "JSON encoding error: %a@." Json.Error.pp e
53
+
end
54
+
else begin
49
55
Fmt.pr "@[<v>";
50
56
Fmt.pr "Subject: %s@," (Apubt.Proto.Webfinger.subject jrd);
51
57
(match Apubt.Proto.Webfinger.aliases jrd with
52
-
| Some aliases ->
53
-
Fmt.pr "Aliases:@,";
54
-
List.iter (fun a -> Fmt.pr " - %s@," a) aliases
55
-
| None -> ());
58
+
| Some aliases ->
59
+
Fmt.pr "Aliases:@,";
60
+
List.iter (fun a -> Fmt.pr " - %s@," a) aliases
61
+
| None -> ());
56
62
(match Apubt.Proto.Webfinger.links jrd with
57
-
| Some links ->
58
-
Fmt.pr "Links:@,";
59
-
List.iter (fun link ->
60
-
let rel = Apubt.Proto.Webfinger.Jrd_link.rel link in
61
-
let href = Apubt.Proto.Webfinger.Jrd_link.href link in
62
-
let type_ = Apubt.Proto.Webfinger.Jrd_link.type_ link in
63
-
Fmt.pr " - rel: %s@," rel;
64
-
Option.iter (fun t -> Fmt.pr " type: %s@," t) type_;
65
-
Option.iter (fun h -> Fmt.pr " href: %s@," (Uri.to_string h)) href
66
-
) links
67
-
| None -> ());
63
+
| Some links ->
64
+
Fmt.pr "Links:@,";
65
+
List.iter
66
+
(fun link ->
67
+
let rel = Apubt.Proto.Webfinger.Jrd_link.rel link in
68
+
let href = Apubt.Proto.Webfinger.Jrd_link.href link in
69
+
let type_ = Apubt.Proto.Webfinger.Jrd_link.type_ link in
70
+
Fmt.pr " - rel: %s@," rel;
71
+
Option.iter (fun t -> Fmt.pr " type: %s@," t) type_;
72
+
Option.iter
73
+
(fun h -> Fmt.pr " href: %s@," (Uri.to_string h))
74
+
href)
75
+
links
76
+
| None -> ());
68
77
(* Show extracted ActivityPub actor URI *)
69
78
(match Apubt.Webfinger.actor_uri jrd with
70
-
| Some uri ->
71
-
Fmt.pr "@,ActivityPub Actor: %s@," (Uri.to_string uri)
72
-
| None ->
73
-
Fmt.pr "@,No ActivityPub actor link found.@,");
79
+
| Some uri -> Fmt.pr "@,ActivityPub Actor: %s@," (Uri.to_string uri)
80
+
| None -> Fmt.pr "@,No ActivityPub actor link found.@,");
74
81
Fmt.pr "@]"
75
82
end;
76
83
`Ok ()
77
-
with
78
-
| Apubt.E err ->
79
-
Fmt.epr "Error: %a@." Apubt.Error.pp err;
80
-
`Error (false, Apubt.Error.to_string err)
84
+
with Apubt.E err ->
85
+
Fmt.epr "Error: %a@." Apubt.Error.pp err;
86
+
`Error (false, Apubt.Error.to_string err)
81
87
82
88
let term =
83
-
Term.(ret (const run $ setup_log_term $ timeout $ user_agent $ json_output $ account))
89
+
Term.(
90
+
ret
91
+
(const run $ setup_log_term $ timeout $ user_agent $ json_output
92
+
$ account))
84
93
85
94
let cmd =
86
95
let doc = "Look up an account via Webfinger." in
87
-
let man = [
88
-
`S Manpage.s_description;
89
-
`P "Performs a Webfinger lookup for the given account and displays \
90
-
the JSON Resource Descriptor (JRD) response.";
91
-
`P "The account can be specified as 'user@domain' or 'acct:user@domain'.";
92
-
`S Manpage.s_examples;
93
-
`Pre " apub webfinger anil@recoil.org";
94
-
`Pre " apub webfinger --json acct:gargron@mastodon.social";
95
-
] in
96
+
let man =
97
+
[
98
+
`S Manpage.s_description;
99
+
`P
100
+
"Performs a Webfinger lookup for the given account and displays the \
101
+
JSON Resource Descriptor (JRD) response.";
102
+
`P
103
+
"The account can be specified as 'user@domain' or 'acct:user@domain'.";
104
+
`S Manpage.s_examples;
105
+
`Pre " apub webfinger anil@recoil.org";
106
+
`Pre " apub webfinger --json acct:gargron@mastodon.social";
107
+
]
108
+
in
96
109
Cmd.v (Cmd.info "webfinger" ~doc ~man) term
97
110
end
98
111
···
104
117
105
118
let json_output =
106
119
let doc = "Output raw JSON response." in
107
-
Arg.(value & flag & info ["json"; "j"] ~doc)
120
+
Arg.(value & flag & info [ "json"; "j" ] ~doc)
108
121
109
122
let run () timeout user_agent json_output uri_or_acct =
110
123
Eio_main.run @@ fun env ->
···
112
125
let client = Apubt.create ~sw ~user_agent ~timeout env in
113
126
try
114
127
let actor =
115
-
if String.contains uri_or_acct '@' && not (String.starts_with ~prefix:"http" uri_or_acct) then
116
-
Apubt.Actor.lookup client uri_or_acct
117
-
else
118
-
Apubt.Actor.fetch client (Uri.of_string uri_or_acct)
128
+
if
129
+
String.contains uri_or_acct '@'
130
+
&& not (String.starts_with ~prefix:"http" uri_or_acct)
131
+
then Apubt.Actor.lookup client uri_or_acct
132
+
else Apubt.Actor.fetch client (Uri.of_string uri_or_acct)
119
133
in
120
-
if json_output then begin
121
-
(try print_endline (Json.to_string Apubt.Proto.Actor.jsont actor)
122
-
with Json.Error e -> Fmt.epr "JSON encoding error: %a@." Json.Error.pp e)
123
-
end else begin
134
+
if json_output then
135
+
begin try print_endline (Json.to_string Apubt.Proto.Actor.jsont actor)
136
+
with Json.Error e ->
137
+
Fmt.epr "JSON encoding error: %a@." Json.Error.pp e
138
+
end
139
+
else begin
124
140
Fmt.pr "@[<v>";
125
141
Fmt.pr "ID: %s@," (Uri.to_string (Apubt.Proto.Actor.id actor));
126
-
Fmt.pr "Type: %s@," (Apubt.Proto.Actor_type.to_string (Apubt.Proto.Actor.type_ actor));
127
-
Option.iter (fun n -> Fmt.pr "Name: %s@," n) (Apubt.Proto.Actor.name actor);
128
-
Option.iter (fun u -> Fmt.pr "Username: %s@," u) (Apubt.Proto.Actor.preferred_username actor);
129
-
Option.iter (fun s -> Fmt.pr "Summary: %s@," s) (Apubt.Proto.Actor.summary actor);
130
-
Option.iter (fun u -> Fmt.pr "URL: %s@," (Uri.to_string u)) (Apubt.Proto.Actor.url actor);
142
+
Fmt.pr "Type: %s@,"
143
+
(Apubt.Proto.Actor_type.to_string (Apubt.Proto.Actor.type_ actor));
144
+
Option.iter
145
+
(fun n -> Fmt.pr "Name: %s@," n)
146
+
(Apubt.Proto.Actor.name actor);
147
+
Option.iter
148
+
(fun u -> Fmt.pr "Username: %s@," u)
149
+
(Apubt.Proto.Actor.preferred_username actor);
150
+
Option.iter
151
+
(fun s -> Fmt.pr "Summary: %s@," s)
152
+
(Apubt.Proto.Actor.summary actor);
153
+
Option.iter
154
+
(fun u -> Fmt.pr "URL: %s@," (Uri.to_string u))
155
+
(Apubt.Proto.Actor.url actor);
131
156
Fmt.pr "Inbox: %s@," (Uri.to_string (Apubt.Proto.Actor.inbox actor));
132
157
Fmt.pr "Outbox: %s@," (Uri.to_string (Apubt.Proto.Actor.outbox actor));
133
-
Option.iter (fun u -> Fmt.pr "Followers: %s@," (Uri.to_string u)) (Apubt.Proto.Actor.followers actor);
134
-
Option.iter (fun u -> Fmt.pr "Following: %s@," (Uri.to_string u)) (Apubt.Proto.Actor.following actor);
158
+
Option.iter
159
+
(fun u -> Fmt.pr "Followers: %s@," (Uri.to_string u))
160
+
(Apubt.Proto.Actor.followers actor);
161
+
Option.iter
162
+
(fun u -> Fmt.pr "Following: %s@," (Uri.to_string u))
163
+
(Apubt.Proto.Actor.following actor);
135
164
Fmt.pr "@]"
136
165
end;
137
166
`Ok ()
138
-
with
139
-
| Apubt.E err ->
140
-
Fmt.epr "Error: %a@." Apubt.Error.pp err;
141
-
`Error (false, Apubt.Error.to_string err)
167
+
with Apubt.E err ->
168
+
Fmt.epr "Error: %a@." Apubt.Error.pp err;
169
+
`Error (false, Apubt.Error.to_string err)
142
170
143
171
let term =
144
-
Term.(ret (const run $ setup_log_term $ timeout $ user_agent $ json_output $ uri_or_acct))
172
+
Term.(
173
+
ret
174
+
(const run $ setup_log_term $ timeout $ user_agent $ json_output
175
+
$ uri_or_acct))
145
176
146
177
let cmd =
147
178
let doc = "Fetch an ActivityPub actor." in
148
-
let man = [
149
-
`S Manpage.s_description;
150
-
`P "Fetches an ActivityPub actor by URI or performs a Webfinger lookup \
151
-
and then fetches the actor.";
152
-
`S Manpage.s_examples;
153
-
`Pre " apub actor anil@recoil.org";
154
-
`Pre " apub actor https://mastodon.social/users/Gargron";
155
-
`Pre " apub actor --json anil@recoil.org";
156
-
] in
179
+
let man =
180
+
[
181
+
`S Manpage.s_description;
182
+
`P
183
+
"Fetches an ActivityPub actor by URI or performs a Webfinger lookup \
184
+
and then fetches the actor.";
185
+
`S Manpage.s_examples;
186
+
`Pre " apub actor anil@recoil.org";
187
+
`Pre " apub actor https://mastodon.social/users/Gargron";
188
+
`Pre " apub actor --json anil@recoil.org";
189
+
]
190
+
in
157
191
Cmd.v (Cmd.info "actor" ~doc ~man) term
158
192
end
159
193
···
165
199
166
200
let limit =
167
201
let doc = "Maximum number of activities to display." in
168
-
Arg.(value & opt int 10 & info ["limit"; "n"] ~docv:"N" ~doc)
202
+
Arg.(value & opt int 10 & info [ "limit"; "n" ] ~docv:"N" ~doc)
169
203
170
204
let json_output =
171
205
let doc = "Output raw JSON response." in
172
-
Arg.(value & flag & info ["json"; "j"] ~doc)
206
+
Arg.(value & flag & info [ "json"; "j" ] ~doc)
173
207
174
208
let run () timeout user_agent json_output limit uri_or_acct =
175
209
Eio_main.run @@ fun env ->
···
177
211
let client = Apubt.create ~sw ~user_agent ~timeout env in
178
212
try
179
213
let actor =
180
-
if String.contains uri_or_acct '@' && not (String.starts_with ~prefix:"http" uri_or_acct) then
181
-
Apubt.Actor.lookup client uri_or_acct
182
-
else
183
-
Apubt.Actor.fetch client (Uri.of_string uri_or_acct)
214
+
if
215
+
String.contains uri_or_acct '@'
216
+
&& not (String.starts_with ~prefix:"http" uri_or_acct)
217
+
then Apubt.Actor.lookup client uri_or_acct
218
+
else Apubt.Actor.fetch client (Uri.of_string uri_or_acct)
184
219
in
185
220
let outbox = Apubt.Actor.outbox client actor in
186
-
if json_output then begin
187
-
(try print_endline (Json.to_string Apubt.Proto.Activity_collection.jsont outbox)
188
-
with Json.Error e -> Fmt.epr "JSON encoding error: %a@." Json.Error.pp e)
189
-
end else begin
221
+
if json_output then
222
+
begin try
223
+
print_endline
224
+
(Json.to_string Apubt.Proto.Activity_collection.jsont outbox)
225
+
with Json.Error e ->
226
+
Fmt.epr "JSON encoding error: %a@." Json.Error.pp e
227
+
end
228
+
else begin
190
229
Fmt.pr "@[<v>";
191
230
Fmt.pr "Outbox for: %s@," (Uri.to_string (Apubt.Proto.Actor.id actor));
192
-
Option.iter (fun n -> Fmt.pr "Total items: %d@," n) (Apubt.Proto.Collection.total_items outbox);
231
+
Option.iter
232
+
(fun n -> Fmt.pr "Total items: %d@," n)
233
+
(Apubt.Proto.Collection.total_items outbox);
193
234
Fmt.pr "@,";
194
235
(* Try to get items from collection or first page *)
195
-
let items = match Apubt.Proto.Collection.items outbox with
236
+
let items =
237
+
match Apubt.Proto.Collection.items outbox with
196
238
| Some items -> items
197
-
| None ->
239
+
| None -> (
198
240
(* Try first page *)
199
-
(try
200
-
let page = Apubt.Actor.outbox_page client actor () in
201
-
Apubt.Proto.Collection_page.items page |> Option.value ~default:[]
202
-
with Apubt.E e ->
203
-
Fmt.pr "(Error fetching first page: %a)@," Apubt.Error.pp e;
204
-
[])
241
+
try
242
+
let page = Apubt.Actor.outbox_page client actor () in
243
+
Apubt.Proto.Collection_page.items page
244
+
|> Option.value ~default:[]
245
+
with Apubt.E e ->
246
+
Fmt.pr "(Error fetching first page: %a)@," Apubt.Error.pp e;
247
+
[])
205
248
in
206
-
let items = if List.length items > limit then
249
+
let items =
250
+
if List.length items > limit then
207
251
List.filteri (fun i _ -> i < limit) items
208
252
else items
209
253
in
210
-
List.iteri (fun i activity ->
211
-
Fmt.pr "--- Activity %d ---@," (i + 1);
212
-
Option.iter (fun id -> Fmt.pr "ID: %s@," (Uri.to_string id)) (Apubt.Proto.Activity.id activity);
213
-
Fmt.pr "Type: %s@," (Apubt.Proto.Activity_type.to_string (Apubt.Proto.Activity.type_ activity));
214
-
Option.iter (fun p -> Fmt.pr "Published: %s@," (Apubt.Proto.Datetime.to_string p)) (Apubt.Proto.Activity.published activity);
215
-
Option.iter (fun s -> Fmt.pr "Summary: %s@," s) (Apubt.Proto.Activity.summary activity);
216
-
(* Show object info if present *)
217
-
(match Apubt.Proto.Activity.object_ activity with
218
-
| Some (Apubt.Proto.Object_ref.Uri uri) ->
219
-
Fmt.pr "Object: %s@," (Uri.to_string uri)
220
-
| Some (Apubt.Proto.Object_ref.Object obj) ->
221
-
Fmt.pr "Object type: %s@," (Apubt.Proto.Object_type.to_string (Apubt.Proto.Object.type_ obj));
222
-
Option.iter (fun c ->
223
-
let c = if String.length c > 100 then String.sub c 0 100 ^ "..." else c in
224
-
Fmt.pr "Content: %s@," c
225
-
) (Apubt.Proto.Object.content obj)
226
-
| None -> ());
227
-
Fmt.pr "@,"
228
-
) items;
254
+
List.iteri
255
+
(fun i activity ->
256
+
Fmt.pr "--- Activity %d ---@," (i + 1);
257
+
Option.iter
258
+
(fun id -> Fmt.pr "ID: %s@," (Uri.to_string id))
259
+
(Apubt.Proto.Activity.id activity);
260
+
Fmt.pr "Type: %s@,"
261
+
(Apubt.Proto.Activity_type.to_string
262
+
(Apubt.Proto.Activity.type_ activity));
263
+
Option.iter
264
+
(fun p ->
265
+
Fmt.pr "Published: %s@," (Apubt.Proto.Datetime.to_string p))
266
+
(Apubt.Proto.Activity.published activity);
267
+
Option.iter
268
+
(fun s -> Fmt.pr "Summary: %s@," s)
269
+
(Apubt.Proto.Activity.summary activity);
270
+
(* Show object info if present *)
271
+
(match Apubt.Proto.Activity.object_ activity with
272
+
| Some (Apubt.Proto.Object_ref.Uri uri) ->
273
+
Fmt.pr "Object: %s@," (Uri.to_string uri)
274
+
| Some (Apubt.Proto.Object_ref.Object obj) ->
275
+
Fmt.pr "Object type: %s@,"
276
+
(Apubt.Proto.Object_type.to_string
277
+
(Apubt.Proto.Object.type_ obj));
278
+
Option.iter
279
+
(fun c ->
280
+
let c =
281
+
if String.length c > 100 then String.sub c 0 100 ^ "..."
282
+
else c
283
+
in
284
+
Fmt.pr "Content: %s@," c)
285
+
(Apubt.Proto.Object.content obj)
286
+
| None -> ());
287
+
Fmt.pr "@,")
288
+
items;
229
289
if List.length items = 0 then
230
290
Fmt.pr "(No activities found or outbox is empty)@,";
231
291
Fmt.pr "@]"
232
292
end;
233
293
`Ok ()
234
-
with
235
-
| Apubt.E err ->
236
-
Fmt.epr "Error: %a@." Apubt.Error.pp err;
237
-
`Error (false, Apubt.Error.to_string err)
294
+
with Apubt.E err ->
295
+
Fmt.epr "Error: %a@." Apubt.Error.pp err;
296
+
`Error (false, Apubt.Error.to_string err)
238
297
239
298
let term =
240
-
Term.(ret (const run $ setup_log_term $ timeout $ user_agent $ json_output $ limit $ uri_or_acct))
299
+
Term.(
300
+
ret
301
+
(const run $ setup_log_term $ timeout $ user_agent $ json_output $ limit
302
+
$ uri_or_acct))
241
303
242
304
let cmd =
243
305
let doc = "Fetch an actor's outbox." in
244
-
let man = [
245
-
`S Manpage.s_description;
246
-
`P "Fetches the outbox of an ActivityPub actor, displaying recent activities.";
247
-
`S Manpage.s_examples;
248
-
`Pre " apub outbox anil@recoil.org";
249
-
`Pre " apub outbox --limit 5 https://mastodon.social/users/Gargron";
250
-
`Pre " apub outbox --json anil@recoil.org";
251
-
] in
306
+
let man =
307
+
[
308
+
`S Manpage.s_description;
309
+
`P
310
+
"Fetches the outbox of an ActivityPub actor, displaying recent \
311
+
activities.";
312
+
`S Manpage.s_examples;
313
+
`Pre " apub outbox anil@recoil.org";
314
+
`Pre " apub outbox --limit 5 https://mastodon.social/users/Gargron";
315
+
`Pre " apub outbox --json anil@recoil.org";
316
+
]
317
+
in
252
318
Cmd.v (Cmd.info "outbox" ~doc ~man) term
253
319
end
254
320
255
321
(* Common signing options for write operations *)
256
322
let key_file =
257
-
let doc = "Path to PEM file containing the private key for signing (overrides saved session)." in
258
-
Arg.(value & opt (some file) None & info ["key-file"; "k"] ~docv:"FILE" ~doc)
323
+
let doc =
324
+
"Path to PEM file containing the private key for signing (overrides saved \
325
+
session)."
326
+
in
327
+
Arg.(
328
+
value & opt (some file) None & info [ "key-file"; "k" ] ~docv:"FILE" ~doc)
259
329
260
330
let key_id =
261
331
let doc = "Key ID for signing (overrides saved session)." in
262
-
Arg.(value & opt (some string) None & info ["key-id"; "K"] ~docv:"URI" ~doc)
332
+
Arg.(value & opt (some string) None & info [ "key-id"; "K" ] ~docv:"URI" ~doc)
263
333
264
334
let actor_uri =
265
335
let doc = "Your actor URI (overrides saved session)." in
266
-
Arg.(value & opt (some string) None & info ["actor"; "a"] ~docv:"URI" ~doc)
336
+
Arg.(value & opt (some string) None & info [ "actor"; "a" ] ~docv:"URI" ~doc)
267
337
268
338
let profile_arg =
269
339
let doc = "Profile to use for credentials (default: current profile)." in
270
-
Arg.(value & opt (some string) None & info ["profile"; "P"] ~docv:"PROFILE" ~doc)
340
+
Arg.(
341
+
value
342
+
& opt (some string) None
343
+
& info [ "profile"; "P" ] ~docv:"PROFILE" ~doc)
271
344
272
345
(* Auth mode - signature-based or OAuth-based *)
273
346
type auth_mode =
···
285
358
(* Resolve credentials from CLI args or saved session *)
286
359
let resolve_credentials env ~key_file ~key_id ~actor_uri ~profile =
287
360
(* If explicit key_file and key_id provided, use those *)
288
-
match key_file, key_id, actor_uri with
361
+
match (key_file, key_id, actor_uri) with
289
362
| Some kf, Some kid, Some actor ->
290
363
let pem = In_channel.with_open_bin kf In_channel.input_all in
291
364
let signing = Apubt.Signing.from_pem_exn ~key_id:kid ~pem () in
292
365
Ok { actor_uri = actor; auth = Signature_auth signing; session = None }
293
-
| None, None, None ->
366
+
| None, None, None -> (
294
367
(* Try loading from session *)
295
368
let fs = env#fs in
296
-
(match Apub_auth_session.load fs ~app_name ?profile () with
297
-
| Some session ->
298
-
(* Prefer OAuth if available, otherwise use signature *)
299
-
let auth = match session.oauth_access_token, session.oauth_instance with
300
-
| Some token, Some instance ->
301
-
OAuth_auth { instance; token }
302
-
| _ ->
303
-
(* Fall back to signature auth if available *)
304
-
(match session.key_id, session.private_key_pem with
305
-
| Some key_id, Some pem ->
306
-
let signing = Apubt.Signing.from_pem_exn ~key_id ~pem () in
307
-
Signature_auth signing
308
-
| _ -> No_auth)
309
-
in
310
-
Ok { actor_uri = session.actor_uri; auth; session = Some session }
311
-
| None ->
312
-
let profile_name = Option.value ~default:(Apub_auth_session.get_current_profile fs ~app_name) profile in
313
-
Error (Printf.sprintf "No credentials found (profile: %s). Use 'apub auth setup' or 'apub auth login' first." profile_name))
314
-
| _, _, Some actor ->
369
+
match Apub_auth_session.load fs ~app_name ?profile () with
370
+
| Some session ->
371
+
(* Prefer OAuth if available, otherwise use signature *)
372
+
let auth =
373
+
match (session.oauth_access_token, session.oauth_instance) with
374
+
| Some token, Some instance -> OAuth_auth { instance; token }
375
+
| _ -> (
376
+
(* Fall back to signature auth if available *)
377
+
match (session.key_id, session.private_key_pem) with
378
+
| Some key_id, Some pem ->
379
+
let signing = Apubt.Signing.from_pem_exn ~key_id ~pem () in
380
+
Signature_auth signing
381
+
| _ -> No_auth)
382
+
in
383
+
Ok { actor_uri = session.actor_uri; auth; session = Some session }
384
+
| None ->
385
+
let profile_name =
386
+
Option.value
387
+
~default:(Apub_auth_session.get_current_profile fs ~app_name)
388
+
profile
389
+
in
390
+
Error
391
+
(Printf.sprintf
392
+
"No credentials found (profile: %s). Use 'apub auth setup' or \
393
+
'apub auth login' first."
394
+
profile_name))
395
+
| _, _, Some actor -> (
315
396
(* Actor provided but no keys - try loading keys from session *)
316
397
let fs = env#fs in
317
-
(match Apub_auth_session.load fs ~app_name ?profile () with
318
-
| Some session ->
319
-
let auth = match session.key_id, session.private_key_pem with
320
-
| Some key_id, Some pem ->
321
-
let signing = Apubt.Signing.from_pem_exn ~key_id ~pem () in
322
-
Signature_auth signing
323
-
| _ -> No_auth
324
-
in
325
-
Ok { actor_uri = actor; auth; session = Some session }
326
-
| None ->
327
-
(* Just use the actor without signing *)
328
-
Ok { actor_uri = actor; auth = No_auth; session = None })
398
+
match Apub_auth_session.load fs ~app_name ?profile () with
399
+
| Some session ->
400
+
let auth =
401
+
match (session.key_id, session.private_key_pem) with
402
+
| Some key_id, Some pem ->
403
+
let signing = Apubt.Signing.from_pem_exn ~key_id ~pem () in
404
+
Signature_auth signing
405
+
| _ -> No_auth
406
+
in
407
+
Ok { actor_uri = actor; auth; session = Some session }
408
+
| None ->
409
+
(* Just use the actor without signing *)
410
+
Ok { actor_uri = actor; auth = No_auth; session = None })
329
411
| _ ->
330
-
Error "Incomplete credentials. Provide all of --actor, --key-file, --key-id, or use 'apub auth setup'."
412
+
Error
413
+
"Incomplete credentials. Provide all of --actor, --key-file, --key-id, \
414
+
or use 'apub auth setup'."
331
415
332
416
(* Helper to create client with resolved credentials *)
333
417
let create_client_with_credentials ~sw ~user_agent ~timeout env creds =
···
343
427
344
428
let reply_to =
345
429
let doc = "URI of the note to reply to." in
346
-
Arg.(value & opt (some string) None & info ["reply-to"; "r"] ~docv:"URI" ~doc)
430
+
Arg.(
431
+
value & opt (some string) None & info [ "reply-to"; "r" ] ~docv:"URI" ~doc)
347
432
348
433
let public =
349
434
let doc = "Post publicly (default)." in
350
-
Arg.(value & flag & info ["public"; "p"] ~doc)
435
+
Arg.(value & flag & info [ "public"; "p" ] ~doc)
351
436
352
437
let followers_only =
353
438
let doc = "Post to followers only." in
354
-
Arg.(value & flag & info ["followers-only"; "f"] ~doc)
439
+
Arg.(value & flag & info [ "followers-only"; "f" ] ~doc)
355
440
356
441
let sensitive =
357
442
let doc = "Mark as sensitive content." in
358
-
Arg.(value & flag & info ["sensitive"; "s"] ~doc)
443
+
Arg.(value & flag & info [ "sensitive"; "s" ] ~doc)
359
444
360
445
let summary =
361
446
let doc = "Content warning / summary text." in
362
-
Arg.(value & opt (some string) None & info ["summary"; "w"] ~docv:"TEXT" ~doc)
447
+
Arg.(
448
+
value & opt (some string) None & info [ "summary"; "w" ] ~docv:"TEXT" ~doc)
363
449
364
-
let run () timeout user_agent key_file key_id actor_uri profile content reply_to
365
-
_public followers_only sensitive cw_summary =
450
+
let run () timeout user_agent key_file key_id actor_uri profile content
451
+
reply_to _public followers_only sensitive cw_summary =
366
452
Eio_main.run @@ fun env ->
367
453
match resolve_credentials env ~key_file ~key_id ~actor_uri ~profile with
368
454
| Error msg ->
369
455
Fmt.epr "Error: %s@." msg;
370
456
`Error (false, msg)
371
-
| Ok creds ->
457
+
| Ok creds -> (
372
458
Eio.Switch.run @@ fun sw ->
373
459
(* Use Mastodon API if OAuth is available *)
374
460
match creds.auth with
375
-
| OAuth_auth { instance; token } ->
376
-
let timeout_config = Requests.Timeout.v ~connect:timeout ~read:timeout () in
461
+
| OAuth_auth { instance; token } -> (
462
+
let timeout_config =
463
+
Requests.Timeout.v ~connect:timeout ~read:timeout ()
464
+
in
377
465
let requests = Requests.v ~sw ~timeout:timeout_config env in
378
-
let visibility = if followers_only then Apub_mastodon_api.Private else Apub_mastodon_api.Public in
466
+
let visibility =
467
+
if followers_only then Apub_mastodon_api.Private
468
+
else Apub_mastodon_api.Public
469
+
in
379
470
let spoiler_text = if sensitive then cw_summary else None in
380
-
(match Apub_mastodon_api.post_status requests ~instance ~token ~content
381
-
~visibility ?in_reply_to_id:reply_to ?sensitive:(if sensitive then Some true else None)
382
-
?spoiler_text () with
471
+
match
472
+
Apub_mastodon_api.post_status requests ~instance ~token ~content
473
+
~visibility ?in_reply_to_id:reply_to
474
+
?sensitive:(if sensitive then Some true else None)
475
+
?spoiler_text ()
476
+
with
383
477
| Ok status ->
384
478
Fmt.pr "Posted: %s@." status.uri;
385
479
Option.iter (fun url -> Fmt.pr "URL: %s@." url) status.url;
···
387
481
| Error msg ->
388
482
Fmt.epr "Error: %s@." msg;
389
483
`Error (false, msg))
390
-
| Signature_auth _ | No_auth ->
484
+
| Signature_auth _ | No_auth -> (
391
485
(* Use ActivityPub federation with HTTP signatures *)
392
-
let client = create_client_with_credentials ~sw ~user_agent ~timeout env creds in
486
+
let client =
487
+
create_client_with_credentials ~sw ~user_agent ~timeout env creds
488
+
in
393
489
try
394
-
let actor = Apubt.Actor.fetch client (Uri.of_string creds.actor_uri) in
490
+
let actor =
491
+
Apubt.Actor.fetch client (Uri.of_string creds.actor_uri)
492
+
in
395
493
let in_reply_to = Option.map Uri.of_string reply_to in
396
494
let _summary = if sensitive then cw_summary else None in
397
495
let activity =
398
496
if followers_only then
399
-
Apubt.Outbox.followers_only_note client ~actor ?in_reply_to ~content ()
497
+
Apubt.Outbox.followers_only_note client ~actor ?in_reply_to
498
+
~content ()
400
499
else
401
-
Apubt.Outbox.public_note client ~actor ?in_reply_to ~content ()
500
+
Apubt.Outbox.public_note client ~actor ?in_reply_to ~content
501
+
()
402
502
in
403
503
let activity_id = Option.get (Apubt.Proto.Activity.id activity) in
404
504
Fmt.pr "Posted: %s@." (Uri.to_string activity_id);
405
505
`Ok ()
406
-
with
407
-
| Apubt.E err ->
408
-
Fmt.epr "Error: %a@." Apubt.Error.pp err;
409
-
`Error (false, Apubt.Error.to_string err)
506
+
with Apubt.E err ->
507
+
Fmt.epr "Error: %a@." Apubt.Error.pp err;
508
+
`Error (false, Apubt.Error.to_string err)))
410
509
411
510
let term =
412
-
Term.(ret (const run $ setup_log_term $ timeout $ user_agent $ key_file
413
-
$ key_id $ actor_uri $ profile_arg $ content $ reply_to $ public
414
-
$ followers_only $ sensitive $ summary))
511
+
Term.(
512
+
ret
513
+
(const run $ setup_log_term $ timeout $ user_agent $ key_file $ key_id
514
+
$ actor_uri $ profile_arg $ content $ reply_to $ public $ followers_only
515
+
$ sensitive $ summary))
415
516
416
517
let cmd =
417
518
let doc = "Post a note." in
418
-
let man = [
419
-
`S Manpage.s_description;
420
-
`P "Creates and posts a new note (status update).";
421
-
`P "Uses saved credentials from 'apub auth setup', or override with --actor, --key-file, --key-id.";
422
-
`S Manpage.s_examples;
423
-
`Pre " apub post \"Hello world!\"";
424
-
`Pre " apub post --reply-to https://other.com/notes/123 \"Nice post!\"";
425
-
`Pre " apub post --followers-only \"Followers only content\"";
426
-
`Pre " apub post --profile work \"Posting from work account\"";
427
-
] in
519
+
let man =
520
+
[
521
+
`S Manpage.s_description;
522
+
`P "Creates and posts a new note (status update).";
523
+
`P
524
+
"Uses saved credentials from 'apub auth setup', or override with \
525
+
--actor, --key-file, --key-id.";
526
+
`S Manpage.s_examples;
527
+
`Pre " apub post \"Hello world!\"";
528
+
`Pre " apub post --reply-to https://other.com/notes/123 \"Nice post!\"";
529
+
`Pre " apub post --followers-only \"Followers only content\"";
530
+
`Pre " apub post --profile work \"Posting from work account\"";
531
+
]
532
+
in
428
533
Cmd.v (Cmd.info "post" ~doc ~man) term
429
534
end
430
535
···
440
545
| Error msg ->
441
546
Fmt.epr "Error: %s@." msg;
442
547
`Error (false, msg)
443
-
| Ok creds ->
548
+
| Ok creds -> (
444
549
Eio.Switch.run @@ fun sw ->
445
550
(* Use Mastodon API if OAuth is available *)
446
551
match creds.auth with
447
-
| OAuth_auth { instance; token } ->
448
-
let timeout_config = Requests.Timeout.v ~connect:timeout ~read:timeout () in
552
+
| OAuth_auth { instance; token } -> (
553
+
let timeout_config =
554
+
Requests.Timeout.v ~connect:timeout ~read:timeout ()
555
+
in
449
556
let requests = Requests.v ~sw ~timeout:timeout_config env in
450
557
(* Look up the account first to get its ID *)
451
-
(match Apub_mastodon_api.lookup_account requests ~instance ~token ~acct:target with
452
-
| Ok account ->
453
-
(match Apub_mastodon_api.follow requests ~instance ~token ~account_id:account.id with
558
+
match
559
+
Apub_mastodon_api.lookup_account requests ~instance ~token
560
+
~acct:target
561
+
with
562
+
| Ok account -> (
563
+
match
564
+
Apub_mastodon_api.follow requests ~instance ~token
565
+
~account_id:account.id
566
+
with
454
567
| Ok rel ->
455
568
Fmt.pr "Follow request sent to: %s@." account.acct;
456
569
if rel.following then Fmt.pr "Status: Now following@."
457
-
else if rel.requested then Fmt.pr "Status: Follow request pending@.";
570
+
else if rel.requested then
571
+
Fmt.pr "Status: Follow request pending@.";
458
572
`Ok ()
459
573
| Error msg ->
460
574
Fmt.epr "Error: %s@." msg;
···
462
576
| Error msg ->
463
577
Fmt.epr "Error looking up account: %s@." msg;
464
578
`Error (false, msg))
465
-
| Signature_auth _ | No_auth ->
579
+
| Signature_auth _ | No_auth -> (
466
580
(* Use ActivityPub federation with HTTP signatures *)
467
-
let client = create_client_with_credentials ~sw ~user_agent ~timeout env creds in
581
+
let client =
582
+
create_client_with_credentials ~sw ~user_agent ~timeout env creds
583
+
in
468
584
try
469
-
let actor = Apubt.Actor.fetch client (Uri.of_string creds.actor_uri) in
585
+
let actor =
586
+
Apubt.Actor.fetch client (Uri.of_string creds.actor_uri)
587
+
in
470
588
let target_actor =
471
-
if String.contains target '@' && not (String.starts_with ~prefix:"http" target) then
472
-
Apubt.Actor.lookup client target
473
-
else
474
-
Apubt.Actor.fetch client (Uri.of_string target)
589
+
if
590
+
String.contains target '@'
591
+
&& not (String.starts_with ~prefix:"http" target)
592
+
then Apubt.Actor.lookup client target
593
+
else Apubt.Actor.fetch client (Uri.of_string target)
475
594
in
476
-
let activity = Apubt.Actor.follow client ~actor ~target:target_actor in
595
+
let activity =
596
+
Apubt.Actor.follow client ~actor ~target:target_actor
597
+
in
477
598
let activity_id = Option.get (Apubt.Proto.Activity.id activity) in
478
599
Fmt.pr "Sent follow request: %s@." (Uri.to_string activity_id);
479
600
Fmt.pr "Target: %s (%s)@."
480
-
(Option.value ~default:"" (Apubt.Proto.Actor.preferred_username target_actor))
601
+
(Option.value ~default:""
602
+
(Apubt.Proto.Actor.preferred_username target_actor))
481
603
(Uri.to_string (Apubt.Proto.Actor.id target_actor));
482
604
`Ok ()
483
-
with
484
-
| Apubt.E err ->
485
-
Fmt.epr "Error: %a@." Apubt.Error.pp err;
486
-
`Error (false, Apubt.Error.to_string err)
605
+
with Apubt.E err ->
606
+
Fmt.epr "Error: %a@." Apubt.Error.pp err;
607
+
`Error (false, Apubt.Error.to_string err)))
487
608
488
609
let term =
489
-
Term.(ret (const run $ setup_log_term $ timeout $ user_agent $ key_file
490
-
$ key_id $ actor_uri $ profile_arg $ target))
610
+
Term.(
611
+
ret
612
+
(const run $ setup_log_term $ timeout $ user_agent $ key_file $ key_id
613
+
$ actor_uri $ profile_arg $ target))
491
614
492
615
let cmd =
493
616
let doc = "Follow an actor." in
494
-
let man = [
495
-
`S Manpage.s_description;
496
-
`P "Sends a Follow activity to another actor.";
497
-
`P "Uses saved credentials from 'apub auth setup' or 'apub auth login'.";
498
-
`S Manpage.s_examples;
499
-
`Pre " apub follow gargron@mastodon.social";
500
-
`Pre " apub follow https://mastodon.social/users/Gargron";
501
-
`Pre " apub follow --profile work colleague@example.com";
502
-
] in
617
+
let man =
618
+
[
619
+
`S Manpage.s_description;
620
+
`P "Sends a Follow activity to another actor.";
621
+
`P "Uses saved credentials from 'apub auth setup' or 'apub auth login'.";
622
+
`S Manpage.s_examples;
623
+
`Pre " apub follow gargron@mastodon.social";
624
+
`Pre " apub follow https://mastodon.social/users/Gargron";
625
+
`Pre " apub follow --profile work colleague@example.com";
626
+
]
627
+
in
503
628
Cmd.v (Cmd.info "follow" ~doc ~man) term
504
629
end
505
630
···
515
640
| Error msg ->
516
641
Fmt.epr "Error: %s@." msg;
517
642
`Error (false, msg)
518
-
| Ok creds ->
643
+
| Ok creds -> (
519
644
Eio.Switch.run @@ fun sw ->
520
645
(* Use Mastodon API if OAuth is available *)
521
646
match creds.auth with
522
-
| OAuth_auth { instance; token } ->
523
-
let timeout_config = Requests.Timeout.v ~connect:timeout ~read:timeout () in
647
+
| OAuth_auth { instance; token } -> (
648
+
let timeout_config =
649
+
Requests.Timeout.v ~connect:timeout ~read:timeout ()
650
+
in
524
651
let requests = Requests.v ~sw ~timeout:timeout_config env in
525
652
(* Extract status ID from URL *)
526
-
(match Apub_mastodon_api.status_id_of_url object_uri with
527
-
| Some status_id ->
528
-
(match Apub_mastodon_api.favourite requests ~instance ~token ~status_id with
653
+
match Apub_mastodon_api.status_id_of_url object_uri with
654
+
| Some status_id -> (
655
+
match
656
+
Apub_mastodon_api.favourite requests ~instance ~token
657
+
~status_id
658
+
with
529
659
| Ok status ->
530
660
Fmt.pr "Liked: %s@." status.uri;
531
661
`Ok ()
···
533
663
Fmt.epr "Error: %s@." msg;
534
664
`Error (false, msg))
535
665
| None ->
536
-
Fmt.epr "Error: Could not extract status ID from URL: %s@." object_uri;
666
+
Fmt.epr "Error: Could not extract status ID from URL: %s@."
667
+
object_uri;
537
668
`Error (false, "Invalid status URL"))
538
-
| Signature_auth _ | No_auth ->
669
+
| Signature_auth _ | No_auth -> (
539
670
(* Use ActivityPub federation with HTTP signatures *)
540
-
let client = create_client_with_credentials ~sw ~user_agent ~timeout env creds in
671
+
let client =
672
+
create_client_with_credentials ~sw ~user_agent ~timeout env creds
673
+
in
541
674
try
542
-
let actor = Apubt.Actor.fetch client (Uri.of_string creds.actor_uri) in
543
-
let activity = Apubt.Outbox.like client ~actor ~object_:(Uri.of_string object_uri) in
675
+
let actor =
676
+
Apubt.Actor.fetch client (Uri.of_string creds.actor_uri)
677
+
in
678
+
let activity =
679
+
Apubt.Outbox.like client ~actor
680
+
~object_:(Uri.of_string object_uri)
681
+
in
544
682
let activity_id = Option.get (Apubt.Proto.Activity.id activity) in
545
683
Fmt.pr "Liked: %s@." object_uri;
546
684
Fmt.pr "Activity: %s@." (Uri.to_string activity_id);
547
685
`Ok ()
548
-
with
549
-
| Apubt.E err ->
550
-
Fmt.epr "Error: %a@." Apubt.Error.pp err;
551
-
`Error (false, Apubt.Error.to_string err)
686
+
with Apubt.E err ->
687
+
Fmt.epr "Error: %a@." Apubt.Error.pp err;
688
+
`Error (false, Apubt.Error.to_string err)))
552
689
553
690
let term =
554
-
Term.(ret (const run $ setup_log_term $ timeout $ user_agent $ key_file
555
-
$ key_id $ actor_uri $ profile_arg $ object_uri))
691
+
Term.(
692
+
ret
693
+
(const run $ setup_log_term $ timeout $ user_agent $ key_file $ key_id
694
+
$ actor_uri $ profile_arg $ object_uri))
556
695
557
696
let cmd =
558
697
let doc = "Like an object." in
559
-
let man = [
560
-
`S Manpage.s_description;
561
-
`P "Sends a Like activity for the specified object (note, article, etc).";
562
-
`P "Uses saved credentials from 'apub auth setup' or 'apub auth login'.";
563
-
`S Manpage.s_examples;
564
-
`Pre " apub like https://mastodon.social/notes/123";
565
-
`Pre " apub like --profile work https://example.com/notes/456";
566
-
] in
698
+
let man =
699
+
[
700
+
`S Manpage.s_description;
701
+
`P
702
+
"Sends a Like activity for the specified object (note, article, etc).";
703
+
`P "Uses saved credentials from 'apub auth setup' or 'apub auth login'.";
704
+
`S Manpage.s_examples;
705
+
`Pre " apub like https://mastodon.social/notes/123";
706
+
`Pre " apub like --profile work https://example.com/notes/456";
707
+
]
708
+
in
567
709
Cmd.v (Cmd.info "like" ~doc ~man) term
568
710
end
569
711
···
579
721
| Error msg ->
580
722
Fmt.epr "Error: %s@." msg;
581
723
`Error (false, msg)
582
-
| Ok creds ->
724
+
| Ok creds -> (
583
725
Eio.Switch.run @@ fun sw ->
584
726
(* Use Mastodon API if OAuth is available *)
585
727
match creds.auth with
586
-
| OAuth_auth { instance; token } ->
587
-
let timeout_config = Requests.Timeout.v ~connect:timeout ~read:timeout () in
728
+
| OAuth_auth { instance; token } -> (
729
+
let timeout_config =
730
+
Requests.Timeout.v ~connect:timeout ~read:timeout ()
731
+
in
588
732
let requests = Requests.v ~sw ~timeout:timeout_config env in
589
733
(* Extract status ID from URL *)
590
-
(match Apub_mastodon_api.status_id_of_url object_uri with
591
-
| Some status_id ->
592
-
(match Apub_mastodon_api.reblog requests ~instance ~token ~status_id with
734
+
match Apub_mastodon_api.status_id_of_url object_uri with
735
+
| Some status_id -> (
736
+
match
737
+
Apub_mastodon_api.reblog requests ~instance ~token ~status_id
738
+
with
593
739
| Ok status ->
594
740
Fmt.pr "Boosted: %s@." status.uri;
595
741
`Ok ()
···
597
743
Fmt.epr "Error: %s@." msg;
598
744
`Error (false, msg))
599
745
| None ->
600
-
Fmt.epr "Error: Could not extract status ID from URL: %s@." object_uri;
746
+
Fmt.epr "Error: Could not extract status ID from URL: %s@."
747
+
object_uri;
601
748
`Error (false, "Invalid status URL"))
602
-
| Signature_auth _ | No_auth ->
749
+
| Signature_auth _ | No_auth -> (
603
750
(* Use ActivityPub federation with HTTP signatures *)
604
-
let client = create_client_with_credentials ~sw ~user_agent ~timeout env creds in
751
+
let client =
752
+
create_client_with_credentials ~sw ~user_agent ~timeout env creds
753
+
in
605
754
try
606
-
let actor = Apubt.Actor.fetch client (Uri.of_string creds.actor_uri) in
607
-
let activity = Apubt.Outbox.announce client ~actor ~object_:(Uri.of_string object_uri) in
755
+
let actor =
756
+
Apubt.Actor.fetch client (Uri.of_string creds.actor_uri)
757
+
in
758
+
let activity =
759
+
Apubt.Outbox.announce client ~actor
760
+
~object_:(Uri.of_string object_uri)
761
+
in
608
762
let activity_id = Option.get (Apubt.Proto.Activity.id activity) in
609
763
Fmt.pr "Boosted: %s@." object_uri;
610
764
Fmt.pr "Activity: %s@." (Uri.to_string activity_id);
611
765
`Ok ()
612
-
with
613
-
| Apubt.E err ->
614
-
Fmt.epr "Error: %a@." Apubt.Error.pp err;
615
-
`Error (false, Apubt.Error.to_string err)
766
+
with Apubt.E err ->
767
+
Fmt.epr "Error: %a@." Apubt.Error.pp err;
768
+
`Error (false, Apubt.Error.to_string err)))
616
769
617
770
let term =
618
-
Term.(ret (const run $ setup_log_term $ timeout $ user_agent $ key_file
619
-
$ key_id $ actor_uri $ profile_arg $ object_uri))
771
+
Term.(
772
+
ret
773
+
(const run $ setup_log_term $ timeout $ user_agent $ key_file $ key_id
774
+
$ actor_uri $ profile_arg $ object_uri))
620
775
621
776
let cmd =
622
777
let doc = "Boost (announce/reblog) an object." in
623
-
let man = [
624
-
`S Manpage.s_description;
625
-
`P "Sends an Announce activity (boost/reblog) for the specified object.";
626
-
`P "Uses saved credentials from 'apub auth setup' or 'apub auth login'.";
627
-
`S Manpage.s_examples;
628
-
`Pre " apub boost https://mastodon.social/notes/123";
629
-
`Pre " apub boost --profile work https://example.com/notes/456";
630
-
] in
778
+
let man =
779
+
[
780
+
`S Manpage.s_description;
781
+
`P "Sends an Announce activity (boost/reblog) for the specified object.";
782
+
`P "Uses saved credentials from 'apub auth setup' or 'apub auth login'.";
783
+
`S Manpage.s_examples;
784
+
`Pre " apub boost https://mastodon.social/notes/123";
785
+
`Pre " apub boost --profile work https://example.com/notes/456";
786
+
]
787
+
in
631
788
Cmd.v (Cmd.info "boost" ~doc ~man) term
632
789
end
633
790
634
791
(* Main command group *)
635
792
let main_cmd =
636
793
let doc = "ActivityPub command-line client" in
637
-
let man = [
638
-
`S Manpage.s_description;
639
-
`P "apub is a command-line tool for interacting with ActivityPub servers.";
640
-
`P "Use 'apub <command> --help' for more information on a specific command.";
641
-
`P "There are two authentication methods:";
642
-
`P "- OAuth login: 'apub auth login user@mastodon.social' (for Mastodon instances)";
643
-
`P "- HTTP signatures: 'apub auth setup <actor-uri> -k <key.pem>' (for federation)";
644
-
`S Manpage.s_commands;
645
-
`S Manpage.s_examples;
646
-
`Pre " # Login to a Mastodon instance via OAuth";
647
-
`Pre " apub auth login alice@mastodon.social";
648
-
`Pre "";
649
-
`Pre " # Or setup with PEM key for federation";
650
-
`Pre " apub auth setup https://example.com/users/alice -k ~/.config/apub/key.pem";
651
-
`Pre "";
652
-
`Pre " # Then use commands without --actor/--key-file/--key-id";
653
-
`Pre " apub post \"Hello world!\"";
654
-
`Pre " apub follow gargron@mastodon.social";
655
-
`Pre " apub like https://mastodon.social/notes/123";
656
-
`Pre "";
657
-
`Pre " # Read-only commands (no credentials needed)";
658
-
`Pre " apub webfinger anil@recoil.org";
659
-
`Pre " apub actor anil@recoil.org";
660
-
`Pre " apub outbox anil@recoil.org";
661
-
] in
794
+
let man =
795
+
[
796
+
`S Manpage.s_description;
797
+
`P "apub is a command-line tool for interacting with ActivityPub servers.";
798
+
`P
799
+
"Use 'apub <command> --help' for more information on a specific \
800
+
command.";
801
+
`P "There are two authentication methods:";
802
+
`P
803
+
"- OAuth login: 'apub auth login user@mastodon.social' (for Mastodon \
804
+
instances)";
805
+
`P
806
+
"- HTTP signatures: 'apub auth setup <actor-uri> -k <key.pem>' (for \
807
+
federation)";
808
+
`S Manpage.s_commands;
809
+
`S Manpage.s_examples;
810
+
`Pre " # Login to a Mastodon instance via OAuth";
811
+
`Pre " apub auth login alice@mastodon.social";
812
+
`Pre "";
813
+
`Pre " # Or setup with PEM key for federation";
814
+
`Pre
815
+
" apub auth setup https://example.com/users/alice -k \
816
+
~/.config/apub/key.pem";
817
+
`Pre "";
818
+
`Pre " # Then use commands without --actor/--key-file/--key-id";
819
+
`Pre " apub post \"Hello world!\"";
820
+
`Pre " apub follow gargron@mastodon.social";
821
+
`Pre " apub like https://mastodon.social/notes/123";
822
+
`Pre "";
823
+
`Pre " # Read-only commands (no credentials needed)";
824
+
`Pre " apub webfinger anil@recoil.org";
825
+
`Pre " apub actor anil@recoil.org";
826
+
`Pre " apub outbox anil@recoil.org";
827
+
]
828
+
in
662
829
let info = Cmd.info "apub" ~version:"0.1" ~doc ~man in
663
-
Cmd.group info [
664
-
Apub_auth_cmd.auth_cmd ~app_name ();
665
-
Webfinger_cmd.cmd;
666
-
Actor_cmd.cmd;
667
-
Outbox_cmd.cmd;
668
-
Post_cmd.cmd;
669
-
Follow_cmd.cmd;
670
-
Like_cmd.cmd;
671
-
Boost_cmd.cmd;
672
-
]
830
+
Cmd.group info
831
+
[
832
+
Apub_auth_cmd.auth_cmd ~app_name ();
833
+
Webfinger_cmd.cmd;
834
+
Actor_cmd.cmd;
835
+
Outbox_cmd.cmd;
836
+
Post_cmd.cmd;
837
+
Follow_cmd.cmd;
838
+
Like_cmd.cmd;
839
+
Boost_cmd.cmd;
840
+
]
673
841
674
842
let () = exit (Cmd.eval main_cmd)
+13
-1
bin/dune
+13
-1
bin/dune
···
2
2
(name apub)
3
3
(public_name apub)
4
4
(package apubt)
5
-
(libraries apubt apub_auth cmdliner eio_main fmt logs logs.cli logs.fmt fmt.cli fmt.tty nox-json requests))
5
+
(libraries
6
+
apubt
7
+
apub_auth
8
+
cmdliner
9
+
eio_main
10
+
fmt
11
+
logs
12
+
logs.cli
13
+
logs.fmt
14
+
fmt.cli
15
+
fmt.tty
16
+
nox-json
17
+
requests))
+51
-51
lib/auth/apub_auth_cmd.ml
+51
-51
lib/auth/apub_auth_cmd.ml
···
20
20
let doc =
21
21
"Key ID (default: <actor_uri>#main-key). Usually the actor's publicKey.id."
22
22
in
23
-
Arg.(
24
-
value & opt (some string) None & info [ "key-id"; "K" ] ~docv:"URI" ~doc)
23
+
Arg.(value & opt (some string) None & info [ "key-id"; "K" ] ~docv:"URI" ~doc)
25
24
26
25
let profile_arg =
27
26
let doc =
···
67
66
| None -> Apub_auth_session.profile_name_of_actor_uri actor_uri
68
67
in
69
68
(* Create and save session *)
70
-
let session =
71
-
Apub_auth_session.create ~actor_uri ~key_id ~private_key_pem
72
-
in
69
+
let session = Apub_auth_session.create ~actor_uri ~key_id ~private_key_pem in
73
70
Apub_auth_session.save fs ~app_name ~profile:profile_name session;
74
71
(* Set as current profile if first setup or explicitly requested *)
75
72
let profiles = Apub_auth_session.list_profiles fs ~app_name in
···
91
88
`Pre
92
89
" apub auth setup https://example.com/users/alice -k \
93
90
~/.config/apub/key.pem";
94
-
`Pre
95
-
" apub auth setup https://mastodon.social/users/bob --profile work";
91
+
`Pre " apub auth setup https://mastodon.social/users/bob --profile work";
96
92
]
97
93
in
98
94
let info = Cmd.info "setup" ~doc ~man in
···
101
97
setup_action ~app_name ~actor_uri ~key_file ~key_id ~profile env
102
98
in
103
99
Cmd.v info
104
-
Term.(const setup' $ actor_uri_arg $ key_file_arg $ key_id_arg $ profile_arg)
100
+
Term.(
101
+
const setup' $ actor_uri_arg $ key_file_arg $ key_id_arg $ profile_arg)
105
102
106
103
(* Login command - OAuth login with Mastodon instance *)
107
104
···
113
110
Crypto_rng_unix.use_default ();
114
111
let fs = env#fs in
115
112
(* Extract instance from account *)
116
-
let instance = match Apub_mastodon_oauth.instance_of_account account with
113
+
let instance =
114
+
match Apub_mastodon_oauth.instance_of_account account with
117
115
| Some i -> i
118
116
| None ->
119
117
Fmt.epr "Error: Invalid account format. Use user@instance.social@.";
···
126
124
let requests = Requests.v ~sw ~timeout:timeout_config env in
127
125
(* Step 1: Register OAuth app *)
128
126
Fmt.pr "Registering OAuth app...@.";
129
-
let app = match Apub_mastodon_oauth.register_app requests ~instance with
127
+
let app =
128
+
match Apub_mastodon_oauth.register_app requests ~instance with
130
129
| Ok app -> app
131
130
| Error msg ->
132
131
Fmt.epr "Error: %s@." msg;
133
132
exit 1
134
133
in
135
134
(* Step 2: Generate PKCE *)
136
-
let (code_verifier, code_challenge) = Apub_mastodon_oauth.Pkce.generate () in
135
+
let code_verifier, code_challenge = Apub_mastodon_oauth.Pkce.generate () in
137
136
(* Step 3: Display authorization URL *)
138
-
let auth_url = Apub_mastodon_oauth.authorization_url
139
-
~instance
140
-
~client_id:app.client_id
141
-
~code_challenge
137
+
let auth_url =
138
+
Apub_mastodon_oauth.authorization_url ~instance ~client_id:app.client_id
139
+
~code_challenge
142
140
in
143
141
Fmt.pr "@.Please visit this URL to authorize:@.";
144
142
Fmt.pr "@. %s@.@." auth_url;
···
151
149
end;
152
150
(* Step 4: Exchange code for token *)
153
151
Fmt.pr "Exchanging authorization code...@.";
154
-
let token = match Apub_mastodon_oauth.exchange_code requests
155
-
~instance
156
-
~client_id:app.client_id
157
-
~client_secret:app.client_secret
158
-
~code
159
-
~code_verifier
160
-
with
152
+
let token =
153
+
match
154
+
Apub_mastodon_oauth.exchange_code requests ~instance
155
+
~client_id:app.client_id ~client_secret:app.client_secret ~code
156
+
~code_verifier
157
+
with
161
158
| Ok t -> t
162
159
| Error msg ->
163
160
Fmt.epr "Error: %s@." msg;
···
165
162
in
166
163
(* Step 5: Verify credentials *)
167
164
Fmt.pr "Verifying credentials...@.";
168
-
let account_info = match Apub_mastodon_oauth.verify_credentials requests
169
-
~instance
170
-
~access_token:token.access_token
171
-
with
165
+
let account_info =
166
+
match
167
+
Apub_mastodon_oauth.verify_credentials requests ~instance
168
+
~access_token:token.access_token
169
+
with
172
170
| Ok a -> a
173
171
| Error msg ->
174
172
Fmt.epr "Error: %s@." msg;
175
173
exit 1
176
174
in
177
175
(* Step 6: Save session *)
178
-
let actor_uri = Apub_mastodon_oauth.actor_uri_of_account_url account_info.url in
179
-
let profile_name = match profile with
176
+
let actor_uri =
177
+
Apub_mastodon_oauth.actor_uri_of_account_url account_info.url
178
+
in
179
+
let profile_name =
180
+
match profile with
180
181
| Some p -> p
181
182
| None -> account_info.acct ^ "@" ^ instance
182
183
in
183
-
let session = Apub_auth_session.create_oauth
184
-
~actor_uri
185
-
~instance
186
-
~access_token:token.access_token
187
-
~client_id:app.client_id
188
-
~client_secret:app.client_secret
184
+
let session =
185
+
Apub_auth_session.create_oauth ~actor_uri ~instance
186
+
~access_token:token.access_token ~client_id:app.client_id
187
+
~client_secret:app.client_secret
189
188
in
190
189
Apub_auth_session.save fs ~app_name ~profile:profile_name session;
191
190
(* Set as current profile if first setup or explicitly requested *)
···
216
215
in
217
216
let info = Cmd.info "login" ~doc ~man in
218
217
let login' account profile =
219
-
Eio_main.run @@ fun env ->
220
-
login_action ~app_name ~account ~profile env
218
+
Eio_main.run @@ fun env -> login_action ~app_name ~account ~profile env
221
219
in
222
220
Cmd.v info Term.(const login' $ account_arg $ profile_arg)
223
221
···
263
261
Fmt.pr "Profile '%s':@." profile;
264
262
Fmt.pr " Actor: %s@." session.actor_uri;
265
263
(* Show signature auth if present *)
266
-
Option.iter (fun key_id ->
267
-
Fmt.pr " Key ID: %s@." key_id
268
-
) session.key_id;
264
+
Option.iter (fun key_id -> Fmt.pr " Key ID: %s@." key_id) session.key_id;
269
265
(* Show OAuth auth if present *)
270
-
Option.iter (fun instance ->
271
-
Fmt.pr " OAuth Instance: %s@." instance
272
-
) session.oauth_instance;
266
+
Option.iter
267
+
(fun instance -> Fmt.pr " OAuth Instance: %s@." instance)
268
+
session.oauth_instance;
273
269
(match session.oauth_access_token with
274
-
| Some _ -> Fmt.pr " OAuth Token: Configured@."
275
-
| None -> ());
270
+
| Some _ -> Fmt.pr " OAuth Token: Configured@."
271
+
| None -> ());
276
272
(* Show auth type summary *)
277
-
let auth_types = List.filter_map (fun x -> x) [
278
-
(if Apub_auth_session.has_signature session then Some "HTTP Signatures" else None);
279
-
(if Apub_auth_session.has_oauth session then Some "OAuth" else None);
280
-
] in
273
+
let auth_types =
274
+
List.filter_map
275
+
(fun x -> x)
276
+
[
277
+
(if Apub_auth_session.has_signature session then
278
+
Some "HTTP Signatures"
279
+
else None);
280
+
(if Apub_auth_session.has_oauth session then Some "OAuth" else None);
281
+
]
282
+
in
281
283
if auth_types <> [] then
282
284
Fmt.pr " Auth: %s@." (String.concat ", " auth_types);
283
285
Fmt.pr " Created: %s@." session.created_at
···
394
396
match profile with
395
397
| Some p -> Printf.sprintf " (profile: %s)" p
396
398
| None ->
397
-
let current =
398
-
Apub_auth_session.get_current_profile fs ~app_name
399
-
in
399
+
let current = Apub_auth_session.get_current_profile fs ~app_name in
400
400
Printf.sprintf " (profile: %s)" current
401
401
in
402
402
Fmt.epr "Not configured%s. Use '%s auth setup' first.@." profile_msg
+9
-10
lib/auth/apub_auth_cmd.mli
+9
-10
lib/auth/apub_auth_cmd.mli
···
24
24
{2 Usage}
25
25
26
26
{[
27
-
(* Add auth commands to your CLI *)
28
-
let cmds =
29
-
[
30
-
Apub_auth_cmd.auth_cmd ~app_name:"apub" ();
31
-
(* ... other commands ... *)
32
-
]
27
+
(* Add auth commands to your CLI *)
28
+
let cmds =
29
+
[
30
+
Apub_auth_cmd.auth_cmd ~app_name:"apub" (); (* ... other commands ... *)
31
+
]
33
32
]} *)
34
33
35
34
(** {1 Command Groups} *)
36
35
37
36
val auth_cmd : app_name:string -> unit -> unit Cmdliner.Cmd.t
38
-
(** [auth_cmd ~app_name ()] creates the auth command group with all
39
-
subcommands. *)
37
+
(** [auth_cmd ~app_name ()] creates the auth command group with all subcommands.
38
+
*)
40
39
41
40
val setup_cmd : app_name:string -> unit -> unit Cmdliner.Cmd.t
42
41
(** [setup_cmd ~app_name ()] creates the setup command for importing keys. *)
···
58
57
(Eio.Fs.dir_ty Eio.Path.t -> Apub_auth_session.t -> 'a) ->
59
58
< fs : Eio.Fs.dir_ty Eio.Path.t ; .. > ->
60
59
'a
61
-
(** [with_session ~app_name ?profile f env] loads the session and calls [f]
62
-
with it, or exits with an error if no session is found. *)
60
+
(** [with_session ~app_name ?profile f env] loads the session and calls [f] with
61
+
it, or exits with an error if no session is found. *)
63
62
64
63
(** {1 Cmdliner Arguments} *)
65
64
+45
-26
lib/auth/apub_auth_session.ml
+45
-26
lib/auth/apub_auth_session.ml
···
18
18
19
19
let jsont =
20
20
Json.Codec.Object.map ~kind:"Session"
21
-
(fun actor_uri key_id private_key_pem oauth_instance oauth_access_token
22
-
oauth_client_id oauth_client_secret created_at ->
23
-
{ actor_uri; key_id; private_key_pem; oauth_instance; oauth_access_token;
24
-
oauth_client_id; oauth_client_secret; created_at })
25
-
|> Json.Codec.Object.member "actor_uri" Json.Codec.string ~enc:(fun s -> s.actor_uri)
26
-
|> Json.Codec.Object.opt_member "key_id" Json.Codec.string ~enc:(fun s -> s.key_id)
21
+
(fun
22
+
actor_uri
23
+
key_id
24
+
private_key_pem
25
+
oauth_instance
26
+
oauth_access_token
27
+
oauth_client_id
28
+
oauth_client_secret
29
+
created_at
30
+
->
31
+
{
32
+
actor_uri;
33
+
key_id;
34
+
private_key_pem;
35
+
oauth_instance;
36
+
oauth_access_token;
37
+
oauth_client_id;
38
+
oauth_client_secret;
39
+
created_at;
40
+
})
41
+
|> Json.Codec.Object.member "actor_uri" Json.Codec.string ~enc:(fun s ->
42
+
s.actor_uri)
43
+
|> Json.Codec.Object.opt_member "key_id" Json.Codec.string ~enc:(fun s ->
44
+
s.key_id)
27
45
|> Json.Codec.Object.opt_member "private_key_pem" Json.Codec.string
28
46
~enc:(fun s -> s.private_key_pem)
29
47
|> Json.Codec.Object.opt_member "oauth_instance" Json.Codec.string
···
34
52
~enc:(fun s -> s.oauth_client_id)
35
53
|> Json.Codec.Object.opt_member "oauth_client_secret" Json.Codec.string
36
54
~enc:(fun s -> s.oauth_client_secret)
37
-
|> Json.Codec.Object.member "created_at" Json.Codec.string ~enc:(fun s -> s.created_at)
55
+
|> Json.Codec.Object.member "created_at" Json.Codec.string ~enc:(fun s ->
56
+
s.created_at)
38
57
|> Json.Codec.Object.seal
39
58
40
59
(* App config stores the current profile *)
···
44
63
Json.Codec.Object.map ~kind:"AppConfig" (fun current_profile ->
45
64
{ current_profile })
46
65
|> Json.Codec.Object.member "current_profile" Json.Codec.string ~enc:(fun c ->
47
-
c.current_profile)
66
+
c.current_profile)
48
67
|> Json.Codec.Object.seal
49
68
50
69
let default_profile = "default"
···
86
105
87
106
let load_app_config fs ~app_name =
88
107
let path = app_config_file fs ~app_name in
89
-
try
90
-
Eio.Path.load path
91
-
|> Json.of_string app_config_jsont
92
-
|> Result.to_option
108
+
try Eio.Path.load path |> Json.of_string app_config_jsont |> Result.to_option
93
109
with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> None
94
110
95
111
let save_app_config fs ~app_name config =
···
113
129
try
114
130
Eio.Path.read_dir profiles
115
131
|> List.filter (fun name ->
116
-
(* Check if it's a directory with a session.json *)
117
-
let dir = Eio.Path.(profiles / name) in
118
-
let session = Eio.Path.(dir / "session.json") in
119
-
try
120
-
ignore (Eio.Path.load session);
121
-
true
122
-
with _ -> false)
132
+
(* Check if it's a directory with a session.json *)
133
+
let dir = Eio.Path.(profiles / name) in
134
+
let session = Eio.Path.(dir / "session.json") in
135
+
try
136
+
ignore (Eio.Path.load session);
137
+
true
138
+
with _ -> false)
123
139
|> List.sort String.compare
124
140
with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> []
125
141
···
137
153
Some current
138
154
in
139
155
let path = session_file fs ~app_name ?profile () in
140
-
try
141
-
Eio.Path.load path |> Json.of_string jsont |> Result.to_option
156
+
try Eio.Path.load path |> Json.of_string jsont |> Result.to_option
142
157
with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> None
143
158
144
159
let save fs ~app_name ?profile session =
···
164
179
let pp ppf session =
165
180
Fmt.pf ppf "@[<v>Actor: %s@," session.actor_uri;
166
181
Option.iter (fun k -> Fmt.pf ppf "Key ID: %s@," k) session.key_id;
167
-
Option.iter (fun i -> Fmt.pf ppf "OAuth Instance: %s@," i) session.oauth_instance;
182
+
Option.iter
183
+
(fun i -> Fmt.pf ppf "OAuth Instance: %s@," i)
184
+
session.oauth_instance;
168
185
(match session.oauth_access_token with
169
-
| Some _ -> Fmt.pf ppf "OAuth: Configured@,"
170
-
| None -> ());
186
+
| Some _ -> Fmt.pf ppf "OAuth: Configured@,"
187
+
| None -> ());
171
188
Fmt.pf ppf "Created: %s@]" session.created_at
172
189
173
190
(* Create a signature-based session from components *)
···
198
215
199
216
(* Merge OAuth credentials into an existing session (for hybrid auth) *)
200
217
let add_oauth session ~instance ~access_token ~client_id ~client_secret =
201
-
{ session with
218
+
{
219
+
session with
202
220
oauth_instance = Some instance;
203
221
oauth_access_token = Some access_token;
204
222
oauth_client_id = Some client_id;
···
211
229
212
230
(* Check if session has OAuth auth *)
213
231
let has_oauth session =
214
-
Option.is_some session.oauth_access_token && Option.is_some session.oauth_instance
232
+
Option.is_some session.oauth_access_token
233
+
&& Option.is_some session.oauth_instance
215
234
216
235
(* Extract a profile name from an actor URI *)
217
236
let profile_name_of_actor_uri uri =
+4
-3
lib/auth/apub_auth_session.mli
+4
-3
lib/auth/apub_auth_session.mli
···
93
93
client_id:string ->
94
94
client_secret:string ->
95
95
t
96
-
(** [add_oauth session ~instance ~access_token ~client_id ~client_secret]
97
-
adds OAuth credentials to an existing session for hybrid auth. *)
96
+
(** [add_oauth session ~instance ~access_token ~client_id ~client_secret] adds
97
+
OAuth credentials to an existing session for hybrid auth. *)
98
98
99
99
val has_signature : t -> bool
100
100
(** [has_signature session] returns true if the session has HTTP signature
···
106
106
107
107
val profile_name_of_actor_uri : string -> string
108
108
(** [profile_name_of_actor_uri uri] extracts a profile name from an actor URI.
109
-
For example, [https://example.com/users/alice] becomes [alice@example.com]. *)
109
+
For example, [https://example.com/users/alice] becomes [alice@example.com].
110
+
*)
110
111
111
112
(** {1 Profile Management} *)
112
113
+63
-36
lib/auth/apub_mastodon_api.ml
+63
-36
lib/auth/apub_mastodon_api.ml
···
14
14
| Private -> "private"
15
15
| Direct -> "direct"
16
16
17
-
(** Status response *)
18
17
type status = {
19
18
id : string;
20
19
uri : string;
···
23
22
created_at : string;
24
23
visibility : string;
25
24
}
25
+
(** Status response *)
26
26
27
27
let status_jsont =
28
28
Json.Codec.Object.map ~kind:"MastodonStatus"
···
31
31
|> Json.Codec.Object.member "id" Json.Codec.string ~enc:(fun s -> s.id)
32
32
|> Json.Codec.Object.member "uri" Json.Codec.string ~enc:(fun s -> s.uri)
33
33
|> Json.Codec.Object.opt_member "url" Json.Codec.string ~enc:(fun s -> s.url)
34
-
|> Json.Codec.Object.member "content" Json.Codec.string ~enc:(fun s -> s.content)
35
-
|> Json.Codec.Object.member "created_at" Json.Codec.string ~enc:(fun s -> s.created_at)
36
-
|> Json.Codec.Object.member "visibility" Json.Codec.string ~enc:(fun s -> s.visibility)
34
+
|> Json.Codec.Object.member "content" Json.Codec.string ~enc:(fun s ->
35
+
s.content)
36
+
|> Json.Codec.Object.member "created_at" Json.Codec.string ~enc:(fun s ->
37
+
s.created_at)
38
+
|> Json.Codec.Object.member "visibility" Json.Codec.string ~enc:(fun s ->
39
+
s.visibility)
37
40
|> Json.Codec.Object.seal
38
41
39
-
(** Relationship response (for follow/unfollow) *)
40
42
type relationship = {
41
43
id : string;
42
44
following : bool;
···
45
47
muting : bool;
46
48
requested : bool;
47
49
}
50
+
(** Relationship response (for follow/unfollow) *)
48
51
49
52
let relationship_jsont =
50
53
Json.Codec.Object.map ~kind:"MastodonRelationship"
51
54
(fun id following followed_by blocking muting requested ->
52
55
{ id; following; followed_by; blocking; muting; requested })
53
56
|> Json.Codec.Object.member "id" Json.Codec.string ~enc:(fun r -> r.id)
54
-
|> Json.Codec.Object.member "following" Json.Codec.bool ~enc:(fun r -> r.following)
55
-
|> Json.Codec.Object.member "followed_by" Json.Codec.bool ~enc:(fun r -> r.followed_by)
56
-
|> Json.Codec.Object.member "blocking" Json.Codec.bool ~enc:(fun r -> r.blocking)
57
+
|> Json.Codec.Object.member "following" Json.Codec.bool ~enc:(fun r ->
58
+
r.following)
59
+
|> Json.Codec.Object.member "followed_by" Json.Codec.bool ~enc:(fun r ->
60
+
r.followed_by)
61
+
|> Json.Codec.Object.member "blocking" Json.Codec.bool ~enc:(fun r ->
62
+
r.blocking)
57
63
|> Json.Codec.Object.member "muting" Json.Codec.bool ~enc:(fun r -> r.muting)
58
-
|> Json.Codec.Object.member "requested" Json.Codec.bool ~enc:(fun r -> r.requested)
64
+
|> Json.Codec.Object.member "requested" Json.Codec.bool ~enc:(fun r ->
65
+
r.requested)
59
66
|> Json.Codec.Object.seal
60
67
61
68
(** Helper to create authenticated headers *)
62
-
let auth_headers token =
63
-
Requests.Headers.empty
64
-
|> Requests.Headers.bearer token
69
+
let auth_headers token = Requests.Headers.empty |> Requests.Headers.bearer token
65
70
66
71
(** Check response and return error if not successful *)
67
72
let check_response resp =
68
73
let status = Requests.Response.status_code resp in
69
-
if status >= 200 && status < 300 then
70
-
Ok ()
74
+
if status >= 200 && status < 300 then Ok ()
71
75
else
72
76
let body = Requests.Response.text resp in
73
77
Error (Printf.sprintf "HTTP %d: %s" status body)
74
78
75
79
(** Post a new status *)
76
-
let post_status requests ~instance ~token ~content
77
-
?(visibility = Public) ?in_reply_to_id ?sensitive ?spoiler_text () =
80
+
let post_status requests ~instance ~token ~content ?(visibility = Public)
81
+
?in_reply_to_id ?sensitive ?spoiler_text () =
78
82
let url = Printf.sprintf "https://%s/api/v1/statuses" instance in
79
83
let headers = auth_headers token in
80
-
let params = [
81
-
("status", content);
82
-
("visibility", string_of_visibility visibility);
83
-
] in
84
-
let params = match in_reply_to_id with
84
+
let params =
85
+
[ ("status", content); ("visibility", string_of_visibility visibility) ]
86
+
in
87
+
let params =
88
+
match in_reply_to_id with
85
89
| Some id -> ("in_reply_to_id", id) :: params
86
90
| None -> params
87
91
in
88
-
let params = match sensitive with
92
+
let params =
93
+
match sensitive with
89
94
| Some true -> ("sensitive", "true") :: params
90
95
| _ -> params
91
96
in
92
-
let params = match spoiler_text with
97
+
let params =
98
+
match spoiler_text with
93
99
| Some text -> ("spoiler_text", text) :: params
94
100
| None -> params
95
101
in
···
101
107
102
108
(** Favourite (like) a status *)
103
109
let favourite requests ~instance ~token ~status_id =
104
-
let url = Printf.sprintf "https://%s/api/v1/statuses/%s/favourite" instance status_id in
110
+
let url =
111
+
Printf.sprintf "https://%s/api/v1/statuses/%s/favourite" instance status_id
112
+
in
105
113
let headers = auth_headers token in
106
114
let resp = Requests.post requests ~headers url in
107
115
match check_response resp with
···
110
118
111
119
(** Unfavourite a status *)
112
120
let unfavourite requests ~instance ~token ~status_id =
113
-
let url = Printf.sprintf "https://%s/api/v1/statuses/%s/unfavourite" instance status_id in
121
+
let url =
122
+
Printf.sprintf "https://%s/api/v1/statuses/%s/unfavourite" instance
123
+
status_id
124
+
in
114
125
let headers = auth_headers token in
115
126
let resp = Requests.post requests ~headers url in
116
127
match check_response resp with
···
119
130
120
131
(** Reblog (boost) a status *)
121
132
let reblog requests ~instance ~token ~status_id =
122
-
let url = Printf.sprintf "https://%s/api/v1/statuses/%s/reblog" instance status_id in
133
+
let url =
134
+
Printf.sprintf "https://%s/api/v1/statuses/%s/reblog" instance status_id
135
+
in
123
136
let headers = auth_headers token in
124
137
let resp = Requests.post requests ~headers url in
125
138
match check_response resp with
···
128
141
129
142
(** Unreblog a status *)
130
143
let unreblog requests ~instance ~token ~status_id =
131
-
let url = Printf.sprintf "https://%s/api/v1/statuses/%s/unreblog" instance status_id in
144
+
let url =
145
+
Printf.sprintf "https://%s/api/v1/statuses/%s/unreblog" instance status_id
146
+
in
132
147
let headers = auth_headers token in
133
148
let resp = Requests.post requests ~headers url in
134
149
match check_response resp with
···
137
152
138
153
(** Follow an account by ID *)
139
154
let follow requests ~instance ~token ~account_id =
140
-
let url = Printf.sprintf "https://%s/api/v1/accounts/%s/follow" instance account_id in
155
+
let url =
156
+
Printf.sprintf "https://%s/api/v1/accounts/%s/follow" instance account_id
157
+
in
141
158
let headers = auth_headers token in
142
159
let resp = Requests.post requests ~headers url in
143
160
match check_response resp with
···
146
163
147
164
(** Unfollow an account by ID *)
148
165
let unfollow requests ~instance ~token ~account_id =
149
-
let url = Printf.sprintf "https://%s/api/v1/accounts/%s/unfollow" instance account_id in
166
+
let url =
167
+
Printf.sprintf "https://%s/api/v1/accounts/%s/unfollow" instance account_id
168
+
in
150
169
let headers = auth_headers token in
151
170
let resp = Requests.post requests ~headers url in
152
171
match check_response resp with
···
155
174
156
175
(** Look up an account by webfinger address (user@domain) *)
157
176
let lookup_account requests ~instance ~token ~acct =
158
-
let url = Printf.sprintf "https://%s/api/v1/accounts/lookup?acct=%s"
159
-
instance (Uri.pct_encode acct) in
177
+
let url =
178
+
Printf.sprintf "https://%s/api/v1/accounts/lookup?acct=%s" instance
179
+
(Uri.pct_encode acct)
180
+
in
160
181
let headers = auth_headers token in
161
182
let resp = Requests.get requests ~headers url in
162
183
match check_response resp with
···
165
186
166
187
(** Search for accounts *)
167
188
let search_accounts requests ~instance ~token ~query ?(limit = 10) () =
168
-
let url = Printf.sprintf "https://%s/api/v1/accounts/search?q=%s&limit=%d"
169
-
instance (Uri.pct_encode query) limit in
189
+
let url =
190
+
Printf.sprintf "https://%s/api/v1/accounts/search?q=%s&limit=%d" instance
191
+
(Uri.pct_encode query) limit
192
+
in
170
193
let headers = auth_headers token in
171
194
let resp = Requests.get requests ~headers url in
172
195
match check_response resp with
173
196
| Error e -> Error e
174
-
| Ok () -> Ok (Requests.Response.jsonv (Json.Codec.list Apub_mastodon_oauth.account_jsont) resp)
197
+
| Ok () ->
198
+
Ok
199
+
(Requests.Response.jsonv
200
+
(Json.Codec.list Apub_mastodon_oauth.account_jsont)
201
+
resp)
175
202
176
203
(** Get a status by ID *)
177
204
let get_status requests ~instance ~token ~status_id =
···
189
216
let resp = Requests.delete requests ~headers url in
190
217
check_response resp
191
218
192
-
(** Extract status ID from a Mastodon URL like https://instance/users/name/statuses/123
193
-
or https://instance/@name/123 *)
219
+
(** Extract status ID from a Mastodon URL like
220
+
https://instance/users/name/statuses/123 or https://instance/@name/123 *)
194
221
let status_id_of_url url =
195
222
let uri = Uri.of_string url in
196
223
let path = Uri.path uri in
+60
-42
lib/auth/apub_mastodon_oauth.ml
+60
-42
lib/auth/apub_mastodon_oauth.ml
···
16
16
(** Redirect URI for out-of-band CLI authorization *)
17
17
let redirect_uri = "urn:ietf:wg:oauth:2.0:oob"
18
18
19
-
(** App registration response *)
20
19
type app = {
21
20
client_id : string;
22
21
client_secret : string;
23
22
vapid_key : string option;
24
23
}
24
+
(** App registration response *)
25
25
26
26
let app_jsont =
27
27
Json.Codec.Object.map ~kind:"MastodonApp"
28
28
(fun client_id client_secret vapid_key ->
29
29
{ client_id; client_secret; vapid_key })
30
-
|> Json.Codec.Object.member "client_id" Json.Codec.string ~enc:(fun a -> a.client_id)
31
-
|> Json.Codec.Object.member "client_secret" Json.Codec.string ~enc:(fun a -> a.client_secret)
32
-
|> Json.Codec.Object.opt_member "vapid_key" Json.Codec.string ~enc:(fun a -> a.vapid_key)
30
+
|> Json.Codec.Object.member "client_id" Json.Codec.string ~enc:(fun a ->
31
+
a.client_id)
32
+
|> Json.Codec.Object.member "client_secret" Json.Codec.string ~enc:(fun a ->
33
+
a.client_secret)
34
+
|> Json.Codec.Object.opt_member "vapid_key" Json.Codec.string ~enc:(fun a ->
35
+
a.vapid_key)
33
36
|> Json.Codec.Object.seal
34
37
35
-
(** Token response *)
36
38
type token = {
37
39
access_token : string;
38
40
token_type : string;
39
41
scope : string;
40
42
created_at : int;
41
43
}
44
+
(** Token response *)
42
45
43
46
let token_jsont =
44
47
Json.Codec.Object.map ~kind:"MastodonToken"
45
48
(fun access_token token_type scope created_at ->
46
49
{ access_token; token_type; scope; created_at })
47
-
|> Json.Codec.Object.member "access_token" Json.Codec.string ~enc:(fun t -> t.access_token)
48
-
|> Json.Codec.Object.member "token_type" Json.Codec.string ~enc:(fun t -> t.token_type)
50
+
|> Json.Codec.Object.member "access_token" Json.Codec.string ~enc:(fun t ->
51
+
t.access_token)
52
+
|> Json.Codec.Object.member "token_type" Json.Codec.string ~enc:(fun t ->
53
+
t.token_type)
49
54
|> Json.Codec.Object.member "scope" Json.Codec.string ~enc:(fun t -> t.scope)
50
-
|> Json.Codec.Object.member "created_at" Json.Codec.int ~enc:(fun t -> t.created_at)
55
+
|> Json.Codec.Object.member "created_at" Json.Codec.int ~enc:(fun t ->
56
+
t.created_at)
51
57
|> Json.Codec.Object.seal
52
58
53
-
(** Account (verify_credentials response) *)
54
59
type account = {
55
60
id : string;
56
61
username : string;
···
58
63
display_name : string option;
59
64
url : string;
60
65
}
66
+
(** Account (verify_credentials response) *)
61
67
62
68
let account_jsont =
63
69
Json.Codec.Object.map ~kind:"MastodonAccount"
64
70
(fun id username acct display_name url ->
65
71
{ id; username; acct; display_name; url })
66
72
|> Json.Codec.Object.member "id" Json.Codec.string ~enc:(fun a -> a.id)
67
-
|> Json.Codec.Object.member "username" Json.Codec.string ~enc:(fun a -> a.username)
73
+
|> Json.Codec.Object.member "username" Json.Codec.string ~enc:(fun a ->
74
+
a.username)
68
75
|> Json.Codec.Object.member "acct" Json.Codec.string ~enc:(fun a -> a.acct)
69
-
|> Json.Codec.Object.opt_member "display_name" Json.Codec.string ~enc:(fun a -> a.display_name)
76
+
|> Json.Codec.Object.opt_member "display_name" Json.Codec.string
77
+
~enc:(fun a -> a.display_name)
70
78
|> Json.Codec.Object.member "url" Json.Codec.string ~enc:(fun a -> a.url)
71
79
|> Json.Codec.Object.seal
72
80
···
94
102
(** Extract instance domain from account handle (user@instance.social) *)
95
103
let instance_of_account account =
96
104
match String.split_on_char '@' account with
97
-
| [_user; instance] -> Some instance
105
+
| [ _user; instance ] -> Some instance
98
106
| _ -> None
99
107
100
108
(** Register a new OAuth app with the instance *)
101
109
let register_app requests ~instance =
102
110
let url = Printf.sprintf "https://%s/api/v1/apps" instance in
103
-
let params = [
104
-
("client_name", client_name);
105
-
("redirect_uris", redirect_uri);
106
-
("scopes", scopes);
107
-
("website", "https://github.com/avsm/apub");
108
-
] in
111
+
let params =
112
+
[
113
+
("client_name", client_name);
114
+
("redirect_uris", redirect_uri);
115
+
("scopes", scopes);
116
+
("website", "https://github.com/avsm/apub");
117
+
]
118
+
in
109
119
let body = Requests.Body.form params in
110
120
let resp = Requests.post requests ~body url in
111
121
let status = Requests.Response.status_code resp in
···
118
128
(** Build the authorization URL for the user to visit *)
119
129
let authorization_url ~instance ~client_id ~code_challenge =
120
130
let base = Printf.sprintf "https://%s/oauth/authorize" instance in
121
-
let params = [
122
-
("response_type", "code");
123
-
("client_id", client_id);
124
-
("redirect_uri", redirect_uri);
125
-
("scope", scopes);
126
-
("code_challenge", code_challenge);
127
-
("code_challenge_method", "S256");
128
-
] in
129
-
let query = String.concat "&" (List.map (fun (k, v) ->
130
-
k ^ "=" ^ Uri.pct_encode v
131
-
) params) in
131
+
let params =
132
+
[
133
+
("response_type", "code");
134
+
("client_id", client_id);
135
+
("redirect_uri", redirect_uri);
136
+
("scope", scopes);
137
+
("code_challenge", code_challenge);
138
+
("code_challenge_method", "S256");
139
+
]
140
+
in
141
+
let query =
142
+
String.concat "&"
143
+
(List.map (fun (k, v) -> k ^ "=" ^ Uri.pct_encode v) params)
144
+
in
132
145
base ^ "?" ^ query
133
146
134
147
(** Exchange authorization code for access token *)
135
-
let exchange_code requests ~instance ~client_id ~client_secret ~code ~code_verifier =
148
+
let exchange_code requests ~instance ~client_id ~client_secret ~code
149
+
~code_verifier =
136
150
let url = Printf.sprintf "https://%s/oauth/token" instance in
137
-
let params = [
138
-
("grant_type", "authorization_code");
139
-
("code", code);
140
-
("client_id", client_id);
141
-
("client_secret", client_secret);
142
-
("redirect_uri", redirect_uri);
143
-
("code_verifier", code_verifier);
144
-
] in
151
+
let params =
152
+
[
153
+
("grant_type", "authorization_code");
154
+
("code", code);
155
+
("client_id", client_id);
156
+
("client_secret", client_secret);
157
+
("redirect_uri", redirect_uri);
158
+
("code_verifier", code_verifier);
159
+
]
160
+
in
145
161
let body = Requests.Body.form params in
146
162
let resp = Requests.post requests ~body url in
147
163
let status = Requests.Response.status_code resp in
···
153
169
154
170
(** Verify credentials and get account info *)
155
171
let verify_credentials requests ~instance ~access_token =
156
-
let url = Printf.sprintf "https://%s/api/v1/accounts/verify_credentials" instance in
172
+
let url =
173
+
Printf.sprintf "https://%s/api/v1/accounts/verify_credentials" instance
174
+
in
157
175
let headers =
158
-
Requests.Headers.empty
159
-
|> Requests.Headers.bearer access_token
176
+
Requests.Headers.empty |> Requests.Headers.bearer access_token
160
177
in
161
178
let resp = Requests.get requests ~headers url in
162
179
let status = Requests.Response.status_code resp in
···
164
181
Ok (Requests.Response.jsonv account_jsont resp)
165
182
else
166
183
let body = Requests.Response.text resp in
167
-
Error (Printf.sprintf "Failed to verify credentials (HTTP %d): %s" status body)
184
+
Error
185
+
(Printf.sprintf "Failed to verify credentials (HTTP %d): %s" status body)
168
186
169
187
(** Get the ActivityPub actor URI from a Mastodon account URL *)
170
188
let actor_uri_of_account_url url =
+341
-342
lib/client/apubt.ml
+341
-342
lib/client/apubt.ml
···
31
31
| Network_error msg -> Format.fprintf fmt "Network error: %s" msg
32
32
| Invalid_actor msg -> Format.fprintf fmt "Invalid actor: %s" msg
33
33
34
-
let to_string t =
35
-
Format.asprintf "%a" pp t
34
+
let to_string t = Format.asprintf "%a" pp t
36
35
end
37
36
38
37
exception E of Error.t
···
46
45
47
46
(** ActivityPub signing components: @method, @authority, @path, date, digest, content-type *)
48
47
let activitypub_components =
49
-
Requests.Signature.Component.[
50
-
method_;
51
-
authority;
52
-
path;
53
-
date;
54
-
content_digest;
55
-
content_type;
56
-
]
48
+
Requests.Signature.Component.
49
+
[ method_; authority; path; date; content_digest; content_type ]
57
50
58
51
let create ~key_id ~key () =
59
-
let config = Requests.Signature.config
60
-
~key
61
-
~keyid:key_id
62
-
~components:activitypub_components
63
-
()
52
+
let config =
53
+
Requests.Signature.config ~key ~keyid:key_id
54
+
~components:activitypub_components ()
64
55
in
65
56
{ key_id; key; config }
66
57
···
70
61
| Ok (`RSA priv) ->
71
62
let key = Requests.Signature.Key.rsa ~priv in
72
63
Ok (create ~key_id ~key ())
73
-
| Ok _ ->
74
-
Error "Only RSA keys are supported for ActivityPub signatures"
75
-
| Error (`Msg msg) ->
76
-
Error ("Failed to parse PEM key: " ^ msg)
64
+
| Ok _ -> Error "Only RSA keys are supported for ActivityPub signatures"
65
+
| Error (`Msg msg) -> Error ("Failed to parse PEM key: " ^ msg)
77
66
78
67
let from_pem_exn ~key_id ~pem () =
79
68
match from_pem ~key_id ~pem () with
···
84
73
let key t = t.key
85
74
end
86
75
87
-
type t = T : {
88
-
requests : Requests.t;
89
-
clock : _ Eio.Time.clock;
90
-
signing : Signing.t option;
91
-
user_agent : string;
92
-
} -> t
76
+
type t =
77
+
| T : {
78
+
requests : Requests.t;
79
+
clock : _ Eio.Time.clock;
80
+
signing : Signing.t option;
81
+
user_agent : string;
82
+
}
83
+
-> t
93
84
94
85
let activitypub_accept =
95
-
"application/activity+json, application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\""
86
+
"application/activity+json, application/ld+json; \
87
+
profile=\"https://www.w3.org/ns/activitystreams\""
96
88
97
89
let create ~sw ?signing ?(user_agent = "Apubt/0.1") ?(timeout = 30.0) env =
98
90
let timeout_config = Requests.Timeout.v ~connect:timeout ~read:timeout () in
···
143
135
let sign_post_request (T t) ~uri ~body ~headers =
144
136
match t.signing with
145
137
| None -> headers
146
-
| Some signing ->
138
+
| Some signing -> (
147
139
(* Add Date header using the session clock *)
148
140
let now_float = Eio.Time.now t.clock in
149
141
let now = Ptime.of_float_s now_float |> Option.get in
150
142
let date_str = Requests.Headers.http_date_of_ptime now in
151
143
let headers = Requests.Headers.set `Date date_str headers in
152
144
(* Create request context for signing *)
153
-
let ctx = Requests.Signature.Context.request
154
-
~method_:`POST
155
-
~uri
156
-
~headers
145
+
let ctx =
146
+
Requests.Signature.Context.request ~method_:`POST ~uri ~headers
157
147
in
158
148
(* Sign with digest (adds Content-Digest header and signs) *)
159
-
match Requests.Signature.sign_with_digest
160
-
~clock:t.clock
161
-
~config:signing.config
162
-
~context:ctx
163
-
~headers
164
-
~body
165
-
~digest_algorithm:`Sha256
149
+
match
150
+
Requests.Signature.sign_with_digest ~clock:t.clock
151
+
~config:signing.config ~context:ctx ~headers ~body
152
+
~digest_algorithm:`Sha256
166
153
with
167
154
| Ok signed_headers -> signed_headers
168
155
| Error err ->
169
156
let msg = Requests.Signature.sign_error_to_string err in
170
-
raise (E (Signature_error msg))
157
+
raise (E (Signature_error msg)))
171
158
172
159
(* Helper to encode JSON to string, raising on error *)
173
160
let encode_json_exn jsont value =
···
183
170
|> Requests.Headers.set `Content_type "application/activity+json"
184
171
in
185
172
let headers = sign_post_request client ~uri ~body:body_str ~headers in
186
-
let resp = Requests.post t.requests ~headers ~body:(Requests.Body.of_string Requests.Mime.json body_str) url in
173
+
let resp =
174
+
Requests.post t.requests ~headers
175
+
~body:(Requests.Body.of_string Requests.Mime.json body_str)
176
+
url
177
+
in
187
178
check_response resp
188
179
189
180
let post_typed (T t as client) jsont uri value =
···
194
185
|> Requests.Headers.set `Content_type "application/activity+json"
195
186
in
196
187
let headers = sign_post_request client ~uri ~body:body_str ~headers in
197
-
let resp = Requests.post t.requests ~headers ~body:(Requests.Body.of_string Requests.Mime.json body_str) url in
188
+
let resp =
189
+
Requests.post t.requests ~headers
190
+
~body:(Requests.Body.of_string Requests.Mime.json body_str)
191
+
url
192
+
in
198
193
check_response resp
199
194
end
200
195
201
196
module Webfinger = struct
202
197
(** Convert a webfinger library Jrd to our internal Proto.Webfinger type *)
203
198
let jrd_of_webfinger (jrd : Webfinger.Jrd.t) : Proto.Webfinger.t =
204
-
let links = List.map (fun (link : Webfinger.Link.t) ->
205
-
Proto.Webfinger.Jrd_link.make
206
-
~rel:(Webfinger.Link.rel link)
207
-
?type_:(Webfinger.Link.type_ link)
208
-
?href:(Option.map Uri.of_string (Webfinger.Link.href link))
209
-
?template:(
210
-
(* Try to get template from properties if it exists *)
211
-
Webfinger.Link.property ~uri:"template" link
212
-
)
213
-
()
214
-
) (Webfinger.Jrd.links jrd) in
215
-
let aliases = match Webfinger.Jrd.aliases jrd with
216
-
| [] -> None
217
-
| a -> Some a
199
+
let links =
200
+
List.map
201
+
(fun (link : Webfinger.Link.t) ->
202
+
Proto.Webfinger.Jrd_link.make ~rel:(Webfinger.Link.rel link)
203
+
?type_:(Webfinger.Link.type_ link)
204
+
?href:(Option.map Uri.of_string (Webfinger.Link.href link))
205
+
?template:
206
+
((* Try to get template from properties if it exists *)
207
+
Webfinger.Link.property ~uri:"template" link)
208
+
())
209
+
(Webfinger.Jrd.links jrd)
210
+
in
211
+
let aliases =
212
+
match Webfinger.Jrd.aliases jrd with [] -> None | a -> Some a
218
213
in
219
-
let properties = match Webfinger.Jrd.properties jrd with
214
+
let properties =
215
+
match Webfinger.Jrd.properties jrd with
220
216
| [] -> None
221
-
| p -> Some (List.filter_map (fun (k, v) ->
222
-
match v with Some s -> Some (k, s) | None -> None
223
-
) p)
217
+
| p ->
218
+
Some
219
+
(List.filter_map
220
+
(fun (k, v) ->
221
+
match v with Some s -> Some (k, s) | None -> None)
222
+
p)
224
223
in
225
224
Proto.Webfinger.make
226
225
~subject:(Option.value ~default:"" (Webfinger.Jrd.subject jrd))
227
-
?aliases
228
-
?properties
229
-
~links
230
-
()
226
+
?aliases ?properties ~links ()
231
227
232
228
let lookup (T t) acct =
233
229
(* Parse the account string into an Acct.t *)
234
230
let acct_uri =
235
231
(* Handle both "user@domain" and "acct:user@domain" formats *)
236
232
let acct_str =
237
-
if String.starts_with ~prefix:"acct:" acct then acct
238
-
else "acct:" ^ acct
233
+
if String.starts_with ~prefix:"acct:" acct then acct else "acct:" ^ acct
239
234
in
240
235
match Webfinger.Acct.of_string acct_str with
241
236
| Ok a -> a
···
250
245
let lookup_raw (T t) acct =
251
246
let acct_uri =
252
247
let acct_str =
253
-
if String.starts_with ~prefix:"acct:" acct then acct
254
-
else "acct:" ^ acct
248
+
if String.starts_with ~prefix:"acct:" acct then acct else "acct:" ^ acct
255
249
in
256
250
match Webfinger.Acct.of_string acct_str with
257
251
| Ok a -> a
···
265
259
match Proto.Webfinger.links jrd with
266
260
| None -> None
267
261
| Some links ->
268
-
List.find_map (fun link ->
269
-
if Proto.Webfinger.Jrd_link.rel link = Webfinger.Rel.activitypub then
270
-
match Proto.Webfinger.Jrd_link.type_ link with
271
-
| Some t when String.equal t "application/activity+json" ->
272
-
Proto.Webfinger.Jrd_link.href link
273
-
| Some t when String.starts_with ~prefix:"application/ld+json" t ->
274
-
Proto.Webfinger.Jrd_link.href link
275
-
| _ -> None
276
-
else None
277
-
) links
262
+
List.find_map
263
+
(fun link ->
264
+
if Proto.Webfinger.Jrd_link.rel link = Webfinger.Rel.activitypub
265
+
then
266
+
match Proto.Webfinger.Jrd_link.type_ link with
267
+
| Some t when String.equal t "application/activity+json" ->
268
+
Proto.Webfinger.Jrd_link.href link
269
+
| Some t when String.starts_with ~prefix:"application/ld+json" t
270
+
->
271
+
Proto.Webfinger.Jrd_link.href link
272
+
| _ -> None
273
+
else None)
274
+
links
278
275
279
276
(** Extract ActivityPub actor URI from a raw Webfinger.Jrd.t *)
280
277
let actor_uri_raw (jrd : Webfinger.Jrd.t) : Uri.t option =
281
278
(* Look for self link with ActivityPub media type *)
282
279
match Webfinger.Jrd.find_link ~rel:Webfinger.Rel.activitypub jrd with
283
-
| Some link ->
284
-
(match Webfinger.Link.type_ link with
285
-
| Some t when String.equal t "application/activity+json" ->
286
-
Option.map Uri.of_string (Webfinger.Link.href link)
287
-
| Some t when String.starts_with ~prefix:"application/ld+json" t ->
288
-
Option.map Uri.of_string (Webfinger.Link.href link)
289
-
| _ -> None)
280
+
| Some link -> (
281
+
match Webfinger.Link.type_ link with
282
+
| Some t when String.equal t "application/activity+json" ->
283
+
Option.map Uri.of_string (Webfinger.Link.href link)
284
+
| Some t when String.starts_with ~prefix:"application/ld+json" t ->
285
+
Option.map Uri.of_string (Webfinger.Link.href link)
286
+
| _ -> None)
290
287
| None -> None
291
288
292
289
let profile_page jrd =
293
290
match Proto.Webfinger.links jrd with
294
291
| None -> None
295
292
| Some links ->
296
-
List.find_map (fun link ->
297
-
if Proto.Webfinger.Jrd_link.rel link = Webfinger.Rel.profile then
298
-
Proto.Webfinger.Jrd_link.href link
299
-
else None
300
-
) links
293
+
List.find_map
294
+
(fun link ->
295
+
if Proto.Webfinger.Jrd_link.rel link = Webfinger.Rel.profile then
296
+
Proto.Webfinger.Jrd_link.href link
297
+
else None)
298
+
links
301
299
302
300
let subscribe_template jrd =
303
301
match Proto.Webfinger.links jrd with
304
302
| None -> None
305
303
| Some links ->
306
-
List.find_map (fun link ->
307
-
if Proto.Webfinger.Jrd_link.rel link = Webfinger.Rel.subscribe then
308
-
Proto.Webfinger.Jrd_link.template link
309
-
else None
310
-
) links
304
+
List.find_map
305
+
(fun link ->
306
+
if Proto.Webfinger.Jrd_link.rel link = Webfinger.Rel.subscribe then
307
+
Proto.Webfinger.Jrd_link.template link
308
+
else None)
309
+
links
311
310
end
312
311
313
312
module Nodeinfo = struct
314
313
(* Well-known nodeinfo link structure *)
315
314
module Well_known_link = struct
316
-
type t = {
317
-
rel : string;
318
-
href : string;
319
-
}
315
+
type t = { rel : string; href : string }
320
316
321
317
let jsont =
322
-
Json.Codec.Object.map ~kind:"WellKnownLink"
323
-
(fun rel href -> { rel; href })
318
+
Json.Codec.Object.map ~kind:"WellKnownLink" (fun rel href ->
319
+
{ rel; href })
324
320
|> Json.Codec.Object.member "rel" Json.Codec.string ~enc:(fun t -> t.rel)
325
-
|> Json.Codec.Object.member "href" Json.Codec.string ~enc:(fun t -> t.href)
321
+
|> Json.Codec.Object.member "href" Json.Codec.string ~enc:(fun t ->
322
+
t.href)
326
323
|> Json.Codec.Object.seal
327
324
end
328
325
329
326
module Well_known = struct
330
-
type t = {
331
-
links : Well_known_link.t list;
332
-
}
327
+
type t = { links : Well_known_link.t list }
333
328
334
329
let jsont =
335
-
Json.Codec.Object.map ~kind:"WellKnownNodeinfo"
336
-
(fun links -> { links })
337
-
|> Json.Codec.Object.member "links" (Json.Codec.list Well_known_link.jsont)
338
-
~enc:(fun t -> t.links)
330
+
Json.Codec.Object.map ~kind:"WellKnownNodeinfo" (fun links -> { links })
331
+
|> Json.Codec.Object.member "links"
332
+
(Json.Codec.list Well_known_link.jsont) ~enc:(fun t -> t.links)
339
333
|> Json.Codec.Object.seal
340
334
end
341
335
342
336
let fetch (T t) ~host =
343
337
(* Step 1: Fetch the well-known nodeinfo discovery document *)
344
-
let well_known_url = Printf.sprintf "https://%s/.well-known/nodeinfo" host in
338
+
let well_known_url =
339
+
Printf.sprintf "https://%s/.well-known/nodeinfo" host
340
+
in
345
341
let headers =
346
-
Requests.Headers.empty
347
-
|> Requests.Headers.add `Accept "application/json"
342
+
Requests.Headers.empty |> Requests.Headers.add `Accept "application/json"
348
343
in
349
344
let resp = Requests.get t.requests ~headers well_known_url in
350
345
check_response resp;
351
346
let well_known = Requests.Response.jsonv Well_known.jsont resp in
352
347
(* Step 2: Find a link with rel containing "nodeinfo" and schema 2.0 or 2.1 *)
353
348
let nodeinfo_href =
354
-
List.find_map (fun (link : Well_known_link.t) ->
355
-
(* Check if rel contains nodeinfo and is schema 2.0 or 2.1 *)
356
-
if String.length link.rel > 0 &&
357
-
(String.ends_with ~suffix:"/schema/2.0" link.rel ||
358
-
String.ends_with ~suffix:"/schema/2.1" link.rel)
359
-
then Some link.href
360
-
else None
361
-
) well_known.links
349
+
List.find_map
350
+
(fun (link : Well_known_link.t) ->
351
+
(* Check if rel contains nodeinfo and is schema 2.0 or 2.1 *)
352
+
if
353
+
String.length link.rel > 0
354
+
&& (String.ends_with ~suffix:"/schema/2.0" link.rel
355
+
|| String.ends_with ~suffix:"/schema/2.1" link.rel)
356
+
then Some link.href
357
+
else None)
358
+
well_known.links
362
359
in
363
360
match nodeinfo_href with
364
-
| None -> raise (E (Json_error "No NodeInfo 2.0 or 2.1 link found in well-known response"))
361
+
| None ->
362
+
raise
363
+
(E
364
+
(Json_error
365
+
"No NodeInfo 2.0 or 2.1 link found in well-known response"))
365
366
| Some href ->
366
367
(* Step 3: Fetch the actual NodeInfo document *)
367
368
let resp = Requests.get t.requests ~headers href in
···
379
380
end
380
381
381
382
module Actor = struct
382
-
let fetch t uri =
383
-
Http.get_typed t Proto.Actor.jsont uri
383
+
let fetch t uri = Http.get_typed t Proto.Actor.jsont uri
384
384
385
385
let lookup t acct =
386
386
(* Use the raw webfinger lookup for efficiency - avoids converting to Proto.Webfinger *)
387
387
let jrd = Webfinger.lookup_raw t acct in
388
388
match Webfinger.actor_uri_raw jrd with
389
389
| Some uri -> fetch t uri
390
-
| None -> raise (E (Webfinger_error "No ActivityPub actor link in Webfinger response"))
390
+
| None ->
391
+
raise
392
+
(E (Webfinger_error "No ActivityPub actor link in Webfinger response"))
391
393
392
394
let inbox _t actor = Proto.Actor.inbox actor
393
395
···
396
398
Http.get_typed t Proto.Activity_collection.jsont uri
397
399
398
400
let outbox_page t actor ?page () =
399
-
let uri = match page with
401
+
let uri =
402
+
match page with
400
403
| Some p -> p
401
-
| None ->
404
+
| None -> (
402
405
let collection = outbox t actor in
403
406
match Proto.Collection.first collection with
404
407
| Some first -> first
405
-
| None -> raise (E (Invalid_actor "Outbox has no first page"))
408
+
| None -> raise (E (Invalid_actor "Outbox has no first page")))
406
409
in
407
410
Http.get_typed t Proto.Activity_collection_page.jsont uri
408
411
409
412
let followers t actor =
410
413
match Proto.Actor.followers actor with
411
-
| Some uri -> Http.get_typed t (Proto.Collection.jsont Proto.Actor.jsont) uri
414
+
| Some uri ->
415
+
Http.get_typed t (Proto.Collection.jsont Proto.Actor.jsont) uri
412
416
| None -> raise (E (Invalid_actor "Actor has no followers collection"))
413
417
414
418
let following t actor =
415
419
match Proto.Actor.following actor with
416
-
| Some uri -> Http.get_typed t (Proto.Collection.jsont Proto.Actor.jsont) uri
420
+
| Some uri ->
421
+
Http.get_typed t (Proto.Collection.jsont Proto.Actor.jsont) uri
417
422
| None -> raise (E (Invalid_actor "Actor has no following collection"))
418
423
419
424
(* Helper to post activity to an actor's inbox *)
···
423
428
424
429
let follow t ~actor ~target =
425
430
(* Create a Follow activity: actor follows target *)
426
-
let follow_activity = Proto.Activity.make
427
-
~context:Proto.Context.default
428
-
~type_:Proto.Activity_type.Follow
429
-
~actor:(Proto.Actor_ref.actor actor)
430
-
~object_:(Proto.Object_ref.uri (Proto.Actor.id target))
431
-
()
431
+
let follow_activity =
432
+
Proto.Activity.make ~context:Proto.Context.default
433
+
~type_:Proto.Activity_type.Follow
434
+
~actor:(Proto.Actor_ref.actor actor)
435
+
~object_:(Proto.Object_ref.uri (Proto.Actor.id target))
436
+
()
432
437
in
433
438
(* Deliver to target's inbox *)
434
439
post_to_inbox t target follow_activity;
···
436
441
437
442
let unfollow t ~actor ~target =
438
443
(* Create a Follow activity representing the original follow *)
439
-
let follow_activity = Proto.Activity.make
440
-
~type_:Proto.Activity_type.Follow
441
-
~actor:(Proto.Actor_ref.actor actor)
442
-
~object_:(Proto.Object_ref.uri (Proto.Actor.id target))
443
-
()
444
+
let follow_activity =
445
+
Proto.Activity.make ~type_:Proto.Activity_type.Follow
446
+
~actor:(Proto.Actor_ref.actor actor)
447
+
~object_:(Proto.Object_ref.uri (Proto.Actor.id target))
448
+
()
444
449
in
445
450
(* Wrap in an Undo activity *)
446
-
let undo_activity = Proto.Activity.make
447
-
~context:Proto.Context.default
448
-
~type_:Proto.Activity_type.Undo
449
-
~actor:(Proto.Actor_ref.actor actor)
450
-
~object_:(Proto.Object_ref.uri (
451
-
match Proto.Activity.id follow_activity with
452
-
| Some id -> id
453
-
| None -> Proto.Actor.id actor (* fallback: use actor ID as base *)
454
-
))
455
-
()
451
+
let undo_activity =
452
+
Proto.Activity.make ~context:Proto.Context.default
453
+
~type_:Proto.Activity_type.Undo
454
+
~actor:(Proto.Actor_ref.actor actor)
455
+
~object_:
456
+
(Proto.Object_ref.uri
457
+
(match Proto.Activity.id follow_activity with
458
+
| Some id -> id
459
+
| None -> Proto.Actor.id actor (* fallback: use actor ID as base *)))
460
+
()
456
461
in
457
462
(* Deliver to target's inbox *)
458
463
post_to_inbox t target undo_activity;
···
461
466
let accept_follow t ~actor ~follow =
462
467
(* Create an Accept activity *)
463
468
(* The object is the Follow activity being accepted *)
464
-
let follow_ref = match Proto.Activity.id follow with
469
+
let follow_ref =
470
+
match Proto.Activity.id follow with
465
471
| Some id -> Proto.Object_ref.uri id
466
472
| None ->
467
473
(* If the follow has no ID, we need to reference it somehow.
468
474
In practice, Follow activities should always have IDs. *)
469
475
Proto.Object_ref.uri (Proto.Actor.id actor)
470
476
in
471
-
let accept_activity = Proto.Activity.make
472
-
~context:Proto.Context.default
473
-
~type_:Proto.Activity_type.Accept
474
-
~actor:(Proto.Actor_ref.actor actor)
475
-
~object_:follow_ref
476
-
()
477
+
let accept_activity =
478
+
Proto.Activity.make ~context:Proto.Context.default
479
+
~type_:Proto.Activity_type.Accept
480
+
~actor:(Proto.Actor_ref.actor actor)
481
+
~object_:follow_ref ()
477
482
in
478
483
(* Get the follower's URI from the Follow activity's actor *)
479
-
let follower_uri = match Proto.Activity.actor follow with
484
+
let follower_uri =
485
+
match Proto.Activity.actor follow with
480
486
| Proto.Actor_ref.Uri uri -> uri
481
487
| Proto.Actor_ref.Actor a -> Proto.Actor.id a
482
488
in
···
488
494
let reject_follow t ~actor ~follow =
489
495
(* Create a Reject activity *)
490
496
(* The object is the Follow activity being rejected *)
491
-
let follow_ref = match Proto.Activity.id follow with
497
+
let follow_ref =
498
+
match Proto.Activity.id follow with
492
499
| Some id -> Proto.Object_ref.uri id
493
500
| None ->
494
501
(* If the follow has no ID, we need to reference it somehow.
495
502
In practice, Follow activities should always have IDs. *)
496
503
Proto.Object_ref.uri (Proto.Actor.id actor)
497
504
in
498
-
let reject_activity = Proto.Activity.make
499
-
~context:Proto.Context.default
500
-
~type_:Proto.Activity_type.Reject
501
-
~actor:(Proto.Actor_ref.actor actor)
502
-
~object_:follow_ref
503
-
()
505
+
let reject_activity =
506
+
Proto.Activity.make ~context:Proto.Context.default
507
+
~type_:Proto.Activity_type.Reject
508
+
~actor:(Proto.Actor_ref.actor actor)
509
+
~object_:follow_ref ()
504
510
in
505
511
(* Get the follower's URI from the Follow activity's actor *)
506
-
let follower_uri = match Proto.Activity.actor follow with
512
+
let follower_uri =
513
+
match Proto.Activity.actor follow with
507
514
| Proto.Actor_ref.Uri uri -> uri
508
515
| Proto.Actor_ref.Actor a -> Proto.Actor.id a
509
516
in
···
514
521
end
515
522
516
523
module Object = struct
517
-
let fetch t uri =
518
-
Http.get_typed t Proto.Object.jsont uri
524
+
let fetch t uri = Http.get_typed t Proto.Object.jsont uri
519
525
520
526
let replies t obj =
521
527
match Proto.Object.replies obj with
···
536
542
let instance_actor_url = Printf.sprintf "https://%s/actor" host in
537
543
try
538
544
let resp = Requests.get t.requests instance_actor_url in
539
-
if Requests.Response.status_code resp >= 200 &&
540
-
Requests.Response.status_code resp < 300 then begin
545
+
if
546
+
Requests.Response.status_code resp >= 200
547
+
&& Requests.Response.status_code resp < 300
548
+
then begin
541
549
let actor = Requests.Response.jsonv Proto.Actor.jsont resp in
542
550
match Proto.Actor.endpoints actor with
543
-
| Some endpoints ->
544
-
Proto.Endpoints.shared_inbox endpoints
551
+
| Some endpoints -> Proto.Endpoints.shared_inbox endpoints
545
552
| None -> None
546
-
end else
547
-
None
553
+
end
554
+
else None
548
555
with _ ->
549
556
(* If fetching instance actor fails, there's no shared inbox *)
550
557
None
551
558
552
559
let post_to_shared_inbox t ~host activity =
553
560
match discover_shared_inbox t ~host with
554
-
| Some shared_inbox ->
555
-
post t ~inbox:shared_inbox activity
561
+
| Some shared_inbox -> post t ~inbox:shared_inbox activity
556
562
| None ->
557
563
(* Fallback: construct a standard shared inbox URL *)
558
-
let shared_inbox = Uri.of_string (Printf.sprintf "https://%s/inbox" host) in
564
+
let shared_inbox =
565
+
Uri.of_string (Printf.sprintf "https://%s/inbox" host)
566
+
in
559
567
post t ~inbox:shared_inbox activity
560
568
end
561
569
···
577
585
578
586
(* Extract inbox URIs from a list of recipients, resolving actors as needed *)
579
587
let resolve_recipient_inboxes t recipients =
580
-
List.filter_map (fun recipient ->
581
-
let uri = Proto.Recipient.id recipient in
582
-
let uri_str = Uri.to_string uri in
583
-
(* Skip the public collection - it doesn't have an inbox *)
584
-
if String.equal uri_str (Uri.to_string Proto.Public.id) then
585
-
None
586
-
else begin
587
-
(* Try to fetch the actor to get their inbox *)
588
-
try
589
-
let actor = Actor.fetch t uri in
590
-
Some (Proto.Actor.inbox actor)
591
-
with E _ ->
592
-
(* If we can't fetch the actor, skip this recipient *)
593
-
None
594
-
end
595
-
) recipients
588
+
List.filter_map
589
+
(fun recipient ->
590
+
let uri = Proto.Recipient.id recipient in
591
+
let uri_str = Uri.to_string uri in
592
+
(* Skip the public collection - it doesn't have an inbox *)
593
+
if String.equal uri_str (Uri.to_string Proto.Public.id) then None
594
+
else
595
+
(* Try to fetch the actor to get their inbox *)
596
+
begin try
597
+
let actor = Actor.fetch t uri in
598
+
Some (Proto.Actor.inbox actor)
599
+
with E _ ->
600
+
(* If we can't fetch the actor, skip this recipient *)
601
+
None
602
+
end)
603
+
recipients
596
604
597
605
(* Deliver an activity to all recipients in to/cc *)
598
606
let deliver t activity =
599
-
let to_recipients = Option.value ~default:[] (Proto.Activity.to_ activity) in
607
+
let to_recipients =
608
+
Option.value ~default:[] (Proto.Activity.to_ activity)
609
+
in
600
610
let cc_recipients = Option.value ~default:[] (Proto.Activity.cc activity) in
601
611
let all_recipients = to_recipients @ cc_recipients in
602
612
let inboxes = resolve_recipient_inboxes t all_recipients in
603
613
(* Deduplicate inboxes *)
604
614
let seen = Hashtbl.create 16 in
605
-
let unique_inboxes = List.filter (fun inbox ->
606
-
let uri_str = Uri.to_string inbox in
607
-
if Hashtbl.mem seen uri_str then false
608
-
else begin
609
-
Hashtbl.add seen uri_str ();
610
-
true
611
-
end
612
-
) inboxes in
615
+
let unique_inboxes =
616
+
List.filter
617
+
(fun inbox ->
618
+
let uri_str = Uri.to_string inbox in
619
+
if Hashtbl.mem seen uri_str then false
620
+
else begin
621
+
Hashtbl.add seen uri_str ();
622
+
true
623
+
end)
624
+
inboxes
625
+
in
613
626
(* Post to each inbox *)
614
-
List.iter (fun inbox ->
615
-
try
616
-
Inbox.post t ~inbox activity
617
-
with E _ ->
618
-
(* Log delivery failures but don't fail the whole operation *)
619
-
()
620
-
) unique_inboxes
627
+
List.iter
628
+
(fun inbox ->
629
+
try Inbox.post t ~inbox activity
630
+
with E _ ->
631
+
(* Log delivery failures but don't fail the whole operation *)
632
+
())
633
+
unique_inboxes
621
634
622
-
let create_note t ~actor ?in_reply_to ?to_ ?cc ?sensitive ?summary ~content () =
635
+
let create_note t ~actor ?in_reply_to ?to_ ?cc ?sensitive ?summary ~content ()
636
+
=
623
637
let note_id = generate_uri ~actor ~suffix:"notes" in
624
638
let activity_id = generate_uri ~actor ~suffix:"activities" in
625
639
let published = now_datetime () in
626
640
(* Build the Note object *)
627
-
let note = Proto.Object.make
628
-
~context:Proto.Context.default
629
-
~id:note_id
630
-
~type_:Proto.Object_type.Note
631
-
~content
632
-
~attributed_to:(Proto.Actor_ref.uri (Proto.Actor.id actor))
633
-
?in_reply_to
634
-
?to_
635
-
?cc
636
-
?sensitive
637
-
?summary
638
-
~published
639
-
()
641
+
let note =
642
+
Proto.Object.make ~context:Proto.Context.default ~id:note_id
643
+
~type_:Proto.Object_type.Note ~content
644
+
~attributed_to:(Proto.Actor_ref.uri (Proto.Actor.id actor))
645
+
?in_reply_to ?to_ ?cc ?sensitive ?summary ~published ()
640
646
in
641
647
(* Build the Create activity *)
642
-
let activity = Proto.Activity.make
643
-
~context:Proto.Context.default
644
-
~id:activity_id
645
-
~type_:Proto.Activity_type.Create
646
-
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
647
-
~object_:(Proto.Object_ref.obj note)
648
-
?to_
649
-
?cc
650
-
~published
651
-
()
648
+
let activity =
649
+
Proto.Activity.make ~context:Proto.Context.default ~id:activity_id
650
+
~type_:Proto.Activity_type.Create
651
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
652
+
~object_:(Proto.Object_ref.obj note)
653
+
?to_ ?cc ~published ()
652
654
in
653
655
(* Deliver to all recipients *)
654
656
deliver t activity;
···
661
663
| None -> Uri.of_string ""
662
664
in
663
665
create_note t ~actor ?in_reply_to
664
-
~to_:[Proto.Recipient.make Proto.Public.id]
665
-
~cc:[Proto.Recipient.make followers_uri]
666
+
~to_:[ Proto.Recipient.make Proto.Public.id ]
667
+
~cc:[ Proto.Recipient.make followers_uri ]
666
668
~content ()
667
669
668
670
let followers_only_note t ~actor ?in_reply_to ~content () =
669
671
let followers_uri =
670
672
match Proto.Actor.followers actor with
671
673
| Some uri -> uri
672
-
| None -> raise (E (Error.Invalid_actor "Actor has no followers collection"))
674
+
| None ->
675
+
raise (E (Error.Invalid_actor "Actor has no followers collection"))
673
676
in
674
677
create_note t ~actor ?in_reply_to
675
-
~to_:[Proto.Recipient.make followers_uri]
678
+
~to_:[ Proto.Recipient.make followers_uri ]
676
679
~content ()
677
680
678
681
let direct_note t ~actor ~to_ ?in_reply_to ~content () =
679
-
let recipients = List.map (fun a -> Proto.Recipient.make (Proto.Actor.id a)) to_ in
682
+
let recipients =
683
+
List.map (fun a -> Proto.Recipient.make (Proto.Actor.id a)) to_
684
+
in
680
685
create_note t ~actor ?in_reply_to ~to_:recipients ~content ()
681
686
682
687
let like t ~actor ~object_ =
···
686
691
let obj = Object.fetch t object_ in
687
692
let to_recipients =
688
693
match Proto.Object.attributed_to obj with
689
-
| Some (Proto.Actor_ref.Uri uri) -> [Proto.Recipient.make uri]
690
-
| Some (Proto.Actor_ref.Actor a) -> [Proto.Recipient.make (Proto.Actor.id a)]
694
+
| Some (Proto.Actor_ref.Uri uri) -> [ Proto.Recipient.make uri ]
695
+
| Some (Proto.Actor_ref.Actor a) ->
696
+
[ Proto.Recipient.make (Proto.Actor.id a) ]
691
697
| None -> []
692
698
in
693
699
(* Build the Like activity *)
694
-
let activity = Proto.Activity.make
695
-
~context:Proto.Context.default
696
-
~id:activity_id
697
-
~type_:Proto.Activity_type.Like
698
-
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
699
-
~object_:(Proto.Object_ref.uri object_)
700
-
~to_:to_recipients
701
-
~published
702
-
()
700
+
let activity =
701
+
Proto.Activity.make ~context:Proto.Context.default ~id:activity_id
702
+
~type_:Proto.Activity_type.Like
703
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
704
+
~object_:(Proto.Object_ref.uri object_)
705
+
~to_:to_recipients ~published ()
703
706
in
704
707
(* Deliver to the object's author *)
705
708
deliver t activity;
···
713
716
let obj = Object.fetch t object_ in
714
717
let to_recipients =
715
718
match Proto.Object.attributed_to obj with
716
-
| Some (Proto.Actor_ref.Uri uri) -> [Proto.Recipient.make uri]
717
-
| Some (Proto.Actor_ref.Actor a) -> [Proto.Recipient.make (Proto.Actor.id a)]
719
+
| Some (Proto.Actor_ref.Uri uri) -> [ Proto.Recipient.make uri ]
720
+
| Some (Proto.Actor_ref.Actor a) ->
721
+
[ Proto.Recipient.make (Proto.Actor.id a) ]
718
722
| None -> []
719
723
in
720
724
(* Build the Undo(Like) activity - reference the Like by URI *)
721
-
let activity = Proto.Activity.make
722
-
~context:Proto.Context.default
723
-
~id:activity_id
724
-
~type_:Proto.Activity_type.Undo
725
-
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
726
-
~object_:(Proto.Object_ref.uri like_id)
727
-
~to_:to_recipients
728
-
~published
729
-
()
725
+
let activity =
726
+
Proto.Activity.make ~context:Proto.Context.default ~id:activity_id
727
+
~type_:Proto.Activity_type.Undo
728
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
729
+
~object_:(Proto.Object_ref.uri like_id)
730
+
~to_:to_recipients ~published ()
730
731
in
731
732
(* Deliver to the object's author *)
732
733
deliver t activity;
···
737
738
let published = now_datetime () in
738
739
(* Get actor's followers for cc *)
739
740
let followers_uri = Proto.Actor.followers actor in
740
-
let cc_recipients = match followers_uri with
741
-
| Some uri -> [Proto.Recipient.make uri]
741
+
let cc_recipients =
742
+
match followers_uri with
743
+
| Some uri -> [ Proto.Recipient.make uri ]
742
744
| None -> []
743
745
in
744
746
(* Fetch the object to find its author for delivery *)
745
747
let obj = Object.fetch t object_ in
746
748
let author_recipients =
747
749
match Proto.Object.attributed_to obj with
748
-
| Some (Proto.Actor_ref.Uri uri) -> [Proto.Recipient.make uri]
749
-
| Some (Proto.Actor_ref.Actor a) -> [Proto.Recipient.make (Proto.Actor.id a)]
750
+
| Some (Proto.Actor_ref.Uri uri) -> [ Proto.Recipient.make uri ]
751
+
| Some (Proto.Actor_ref.Actor a) ->
752
+
[ Proto.Recipient.make (Proto.Actor.id a) ]
750
753
| None -> []
751
754
in
752
755
(* to: public, author; cc: followers *)
753
-
let to_recipients = Proto.Recipient.make Proto.Public.id :: author_recipients in
756
+
let to_recipients =
757
+
Proto.Recipient.make Proto.Public.id :: author_recipients
758
+
in
754
759
(* Build the Announce activity *)
755
-
let activity = Proto.Activity.make
756
-
~context:Proto.Context.default
757
-
~id:activity_id
758
-
~type_:Proto.Activity_type.Announce
759
-
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
760
-
~object_:(Proto.Object_ref.uri object_)
761
-
~to_:to_recipients
762
-
~cc:cc_recipients
763
-
~published
764
-
()
760
+
let activity =
761
+
Proto.Activity.make ~context:Proto.Context.default ~id:activity_id
762
+
~type_:Proto.Activity_type.Announce
763
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
764
+
~object_:(Proto.Object_ref.uri object_)
765
+
~to_:to_recipients ~cc:cc_recipients ~published ()
765
766
in
766
767
(* Deliver to followers and the object's author *)
767
768
deliver t activity;
···
773
774
let published = now_datetime () in
774
775
(* Get actor's followers for cc *)
775
776
let followers_uri = Proto.Actor.followers actor in
776
-
let cc_recipients = match followers_uri with
777
-
| Some uri -> [Proto.Recipient.make uri]
777
+
let cc_recipients =
778
+
match followers_uri with
779
+
| Some uri -> [ Proto.Recipient.make uri ]
778
780
| None -> []
779
781
in
780
782
(* Fetch the object to find its author for delivery *)
781
783
let obj = Object.fetch t object_ in
782
784
let author_recipients =
783
785
match Proto.Object.attributed_to obj with
784
-
| Some (Proto.Actor_ref.Uri uri) -> [Proto.Recipient.make uri]
785
-
| Some (Proto.Actor_ref.Actor a) -> [Proto.Recipient.make (Proto.Actor.id a)]
786
+
| Some (Proto.Actor_ref.Uri uri) -> [ Proto.Recipient.make uri ]
787
+
| Some (Proto.Actor_ref.Actor a) ->
788
+
[ Proto.Recipient.make (Proto.Actor.id a) ]
786
789
| None -> []
787
790
in
788
-
let to_recipients = Proto.Recipient.make Proto.Public.id :: author_recipients in
791
+
let to_recipients =
792
+
Proto.Recipient.make Proto.Public.id :: author_recipients
793
+
in
789
794
(* Build the Undo(Announce) activity *)
790
-
let activity = Proto.Activity.make
791
-
~context:Proto.Context.default
792
-
~id:activity_id
793
-
~type_:Proto.Activity_type.Undo
794
-
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
795
-
~object_:(Proto.Object_ref.uri announce_id)
796
-
~to_:to_recipients
797
-
~cc:cc_recipients
798
-
~published
799
-
()
795
+
let activity =
796
+
Proto.Activity.make ~context:Proto.Context.default ~id:activity_id
797
+
~type_:Proto.Activity_type.Undo
798
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
799
+
~object_:(Proto.Object_ref.uri announce_id)
800
+
~to_:to_recipients ~cc:cc_recipients ~published ()
800
801
in
801
802
(* Deliver to followers and the object's author *)
802
803
deliver t activity;
···
810
811
let to_recipients = Option.value ~default:[] (Proto.Object.to_ obj) in
811
812
let cc_recipients = Option.value ~default:[] (Proto.Object.cc obj) in
812
813
(* Create a Tombstone object *)
813
-
let tombstone = Proto.Object.make
814
-
~id:object_
815
-
~type_:Proto.Object_type.Tombstone
816
-
~published
817
-
()
814
+
let tombstone =
815
+
Proto.Object.make ~id:object_ ~type_:Proto.Object_type.Tombstone
816
+
~published ()
818
817
in
819
818
(* Build the Delete activity *)
820
-
let activity = Proto.Activity.make
821
-
~context:Proto.Context.default
822
-
~id:activity_id
823
-
~type_:Proto.Activity_type.Delete
824
-
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
825
-
~object_:(Proto.Object_ref.obj tombstone)
826
-
~to_:to_recipients
827
-
~cc:cc_recipients
828
-
~published
829
-
()
819
+
let activity =
820
+
Proto.Activity.make ~context:Proto.Context.default ~id:activity_id
821
+
~type_:Proto.Activity_type.Delete
822
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
823
+
~object_:(Proto.Object_ref.obj tombstone)
824
+
~to_:to_recipients ~cc:cc_recipients ~published ()
830
825
in
831
826
(* Deliver to previous recipients *)
832
827
deliver t activity;
···
840
835
let to_recipients = Option.value ~default:[] (Proto.Object.to_ original) in
841
836
let cc_recipients = Option.value ~default:[] (Proto.Object.cc original) in
842
837
(* Create the updated Note object *)
843
-
let updated_note = Proto.Object.make
844
-
~context:Proto.Context.default
845
-
~id:object_
846
-
~type_:Proto.Object_type.Note
847
-
~content
848
-
~attributed_to:(Proto.Actor_ref.uri (Proto.Actor.id actor))
849
-
?in_reply_to:(Proto.Object.in_reply_to original)
850
-
~to_:to_recipients
851
-
~cc:cc_recipients
852
-
?summary:(Proto.Object.summary original)
853
-
?sensitive:(Proto.Object.sensitive original)
854
-
~updated:published
855
-
?published:(Proto.Object.published original)
856
-
()
838
+
let updated_note =
839
+
Proto.Object.make ~context:Proto.Context.default ~id:object_
840
+
~type_:Proto.Object_type.Note ~content
841
+
~attributed_to:(Proto.Actor_ref.uri (Proto.Actor.id actor))
842
+
?in_reply_to:(Proto.Object.in_reply_to original)
843
+
~to_:to_recipients ~cc:cc_recipients
844
+
?summary:(Proto.Object.summary original)
845
+
?sensitive:(Proto.Object.sensitive original)
846
+
~updated:published
847
+
?published:(Proto.Object.published original)
848
+
()
857
849
in
858
850
(* Build the Update activity *)
859
-
let activity = Proto.Activity.make
860
-
~context:Proto.Context.default
861
-
~id:activity_id
862
-
~type_:Proto.Activity_type.Update
863
-
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
864
-
~object_:(Proto.Object_ref.obj updated_note)
865
-
~to_:to_recipients
866
-
~cc:cc_recipients
867
-
~published
868
-
()
851
+
let activity =
852
+
Proto.Activity.make ~context:Proto.Context.default ~id:activity_id
853
+
~type_:Proto.Activity_type.Update
854
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
855
+
~object_:(Proto.Object_ref.obj updated_note)
856
+
~to_:to_recipients ~cc:cc_recipients ~published ()
869
857
in
870
858
(* Deliver to recipients *)
871
859
deliver t activity;
···
876
864
let rec iter t f collection item_jsont =
877
865
(* Process items in current collection if any *)
878
866
(match Proto.Collection.items collection with
879
-
| Some items -> List.iter f items
880
-
| None -> ());
867
+
| Some items -> List.iter f items
868
+
| None -> ());
881
869
(* Fetch first page if available *)
882
870
match Proto.Collection.first collection with
883
871
| Some first_uri ->
884
-
let page = Http.get_typed t (Proto.Collection_page.jsont item_jsont) first_uri in
872
+
let page =
873
+
Http.get_typed t (Proto.Collection_page.jsont item_jsont) first_uri
874
+
in
885
875
iter_page t f page item_jsont
886
876
| None -> ()
887
877
888
878
and iter_page t f page item_jsont =
889
879
(* Process items in page *)
890
880
(match Proto.Collection_page.items page with
891
-
| Some items -> List.iter f items
892
-
| None -> ());
881
+
| Some items -> List.iter f items
882
+
| None -> ());
893
883
(* Fetch next page if available *)
894
884
match Proto.Collection_page.next page with
895
885
| Some next_uri ->
896
-
let next = Http.get_typed t (Proto.Collection_page.jsont item_jsont) next_uri in
886
+
let next =
887
+
Http.get_typed t (Proto.Collection_page.jsont item_jsont) next_uri
888
+
in
897
889
iter_page t f next item_jsont
898
890
| None -> ()
899
891
900
892
let rec fold t f init collection item_jsont =
901
893
(* Fold over items in current collection *)
902
-
let acc = match Proto.Collection.items collection with
894
+
let acc =
895
+
match Proto.Collection.items collection with
903
896
| Some items -> List.fold_left f init items
904
897
| None -> init
905
898
in
906
899
(* Fetch first page if available *)
907
900
match Proto.Collection.first collection with
908
901
| Some first_uri ->
909
-
let page = Http.get_typed t (Proto.Collection_page.jsont item_jsont) first_uri in
902
+
let page =
903
+
Http.get_typed t (Proto.Collection_page.jsont item_jsont) first_uri
904
+
in
910
905
fold_page t f acc page item_jsont
911
906
| None -> acc
912
907
913
908
and fold_page t f acc page item_jsont =
914
909
(* Fold over items in page *)
915
-
let acc = match Proto.Collection_page.items page with
910
+
let acc =
911
+
match Proto.Collection_page.items page with
916
912
| Some items -> List.fold_left f acc items
917
913
| None -> acc
918
914
in
919
915
(* Fetch next page if available *)
920
916
match Proto.Collection_page.next page with
921
917
| Some next_uri ->
922
-
let next = Http.get_typed t (Proto.Collection_page.jsont item_jsont) next_uri in
918
+
let next =
919
+
Http.get_typed t (Proto.Collection_page.jsont item_jsont) next_uri
920
+
in
923
921
fold_page t f acc next item_jsont
924
922
| None -> acc
925
923
926
924
let to_list t collection item_jsont =
927
-
fold t (fun acc item -> item :: acc) [] collection item_jsont
928
-
|> List.rev
925
+
fold t (fun acc item -> item :: acc) [] collection item_jsont |> List.rev
929
926
930
927
let first_page t collection item_jsont =
931
928
match Proto.Collection.first collection with
932
929
| Some first_uri ->
933
-
Some (Http.get_typed t (Proto.Collection_page.jsont item_jsont) first_uri)
930
+
Some
931
+
(Http.get_typed t (Proto.Collection_page.jsont item_jsont) first_uri)
934
932
| None -> None
935
933
936
934
let next_page t page item_jsont =
937
935
match Proto.Collection_page.next page with
938
936
| Some next_uri ->
939
-
Some (Http.get_typed t (Proto.Collection_page.jsont item_jsont) next_uri)
937
+
Some
938
+
(Http.get_typed t (Proto.Collection_page.jsont item_jsont) next_uri)
940
939
| None -> None
941
940
end
+81
-96
lib/client/apubt.mli
+81
-96
lib/client/apubt.mli
···
6
6
(** ActivityPub client library for OCaml with Eio
7
7
8
8
This library provides a direct-style ActivityPub client using Eio for
9
-
concurrent I/O. It handles actor discovery, inbox/outbox operations,
10
-
HTTP signatures, and federation with other ActivityPub servers.
9
+
concurrent I/O. It handles actor discovery, inbox/outbox operations, HTTP
10
+
signatures, and federation with other ActivityPub servers.
11
11
12
12
{2 Overview}
13
13
···
23
23
{2 Example}
24
24
25
25
{[
26
-
open Eio.Std
26
+
open Eio.Std
27
27
28
-
let () = Eio_main.run @@ fun env ->
29
-
Switch.run @@ fun sw ->
28
+
let () =
29
+
Eio_main.run @@ fun env ->
30
+
Switch.run @@ fun sw ->
31
+
(* Create an ActivityPub client *)
32
+
let client = Apubt.create ~sw env in
30
33
31
-
(* Create an ActivityPub client *)
32
-
let client = Apubt.create ~sw env in
34
+
(* Discover an actor via Webfinger *)
35
+
let actor = Apubt.Actor.lookup client "user@example.com" in
36
+
Printf.printf "Found: %s\n"
37
+
(Option.value ~default:"<none>" (Proto.Actor.name actor));
33
38
34
-
(* Discover an actor via Webfinger *)
35
-
let actor = Apubt.Actor.lookup client "user@example.com" in
36
-
Printf.printf "Found: %s\n" (Option.value ~default:"<none>" (Proto.Actor.name actor));
37
-
38
-
(* Fetch their outbox *)
39
-
let outbox = Apubt.Actor.outbox client actor in
40
-
List.iter (fun activity ->
39
+
(* Fetch their outbox *)
40
+
let outbox = Apubt.Actor.outbox client actor in
41
+
List.iter
42
+
(fun activity ->
41
43
Printf.printf "Activity: %s\n"
42
-
(Proto.Activity_type.to_string (Proto.Activity.type_ activity))
43
-
) (Option.value ~default:[] (Proto.Collection.items outbox))
44
+
(Proto.Activity_type.to_string (Proto.Activity.type_ activity)))
45
+
(Option.value ~default:[] (Proto.Collection.items outbox))
44
46
]}
45
47
46
48
{2 HTTP Signatures}
···
72
74
73
75
(** HTTP signature configuration for authenticated requests.
74
76
75
-
Uses RFC 9421 HTTP Message Signatures via the Requests library.
76
-
ActivityPub typically uses RSA-SHA256 signatures.
77
+
Uses RFC 9421 HTTP Message Signatures via the Requests library. ActivityPub
78
+
typically uses RSA-SHA256 signatures.
77
79
78
80
The following message components are signed:
79
81
- [@method] - HTTP request method
···
86
88
type t
87
89
(** Signing configuration. *)
88
90
89
-
val create :
90
-
key_id:string ->
91
-
key:Requests.Signature.Key.t ->
92
-
unit ->
93
-
t
91
+
val create : key_id:string -> key:Requests.Signature.Key.t -> unit -> t
94
92
(** [create ~key_id ~key ()] creates a signing configuration.
95
93
96
94
@param key_id The key ID URI (typically actor URI + "#main-key")
97
95
@param key The cryptographic key from {!Requests.Signature.Key} *)
98
96
99
-
val from_pem :
100
-
key_id:string ->
101
-
pem:string ->
102
-
unit ->
103
-
(t, string) result
97
+
val from_pem : key_id:string -> pem:string -> unit -> (t, string) result
104
98
(** [from_pem ~key_id ~pem ()] creates a signing configuration from a
105
99
PEM-encoded RSA private key.
106
100
···
108
102
@param pem PEM-encoded RSA private key
109
103
@return [Ok t] on success, [Error msg] if PEM parsing fails *)
110
104
111
-
val from_pem_exn :
112
-
key_id:string ->
113
-
pem:string ->
114
-
unit ->
115
-
t
116
-
(** [from_pem_exn ~key_id ~pem ()] is like {!from_pem} but raises
117
-
{!E} with {!Error.Signature_error} on failure. *)
105
+
val from_pem_exn : key_id:string -> pem:string -> unit -> t
106
+
(** [from_pem_exn ~key_id ~pem ()] is like {!from_pem} but raises {!E} with
107
+
{!Error.Signature_error} on failure. *)
118
108
119
109
val key_id : t -> string
120
110
(** [key_id t] returns the key ID URI. *)
···
133
123
; fs : Eio.Fs.dir_ty Eio.Path.t
134
124
; .. > ->
135
125
t
136
-
(** [create ~sw ?signing ?user_agent ?timeout env] creates an ActivityPub client.
126
+
(** [create ~sw ?signing ?user_agent ?timeout env] creates an ActivityPub
127
+
client.
137
128
138
129
@param sw Switch for resource management
139
130
@param signing HTTP signature configuration for authenticated requests
···
154
145
| Signature_error of string (** HTTP signature error *)
155
146
| Not_found (** Resource not found (404) *)
156
147
| Unauthorized (** Authentication required or failed (401/403) *)
157
-
| Rate_limited of float option (** Rate limited, with optional retry-after *)
148
+
| Rate_limited of float option
149
+
(** Rate limited, with optional retry-after *)
158
150
| Network_error of string (** Network/connection error *)
159
151
| Invalid_actor of string (** Actor validation failed *)
160
152
···
174
166
175
167
This module uses the [webfinger] library for robust RFC 7033/7565 compliance
176
168
with proper acct URI handling and percent-encoding. See the
177
-
{{:https://swicg.github.io/activitypub-webfinger/}ActivityPub WebFinger spec}
178
-
for details on how WebFinger is used with ActivityPub.
169
+
{{:https://swicg.github.io/activitypub-webfinger/}ActivityPub WebFinger
170
+
spec} for details on how WebFinger is used with ActivityPub.
179
171
180
172
@see <https://www.rfc-editor.org/rfc/rfc7033> RFC 7033 WebFinger
181
173
@see <https://www.rfc-editor.org/rfc/rfc7565> RFC 7565 acct URI *)
···
183
175
val lookup : t -> string -> Proto.Webfinger.t
184
176
(** [lookup client acct] performs a Webfinger lookup for the given account.
185
177
186
-
The [acct] can be in the form "user@domain" or "acct:user@domain".
187
-
Uses the [webfinger] library for proper RFC 7565 acct URI handling.
178
+
The [acct] can be in the form "user@domain" or "acct:user@domain". Uses
179
+
the [webfinger] library for proper RFC 7565 acct URI handling.
188
180
189
181
@raise E on lookup failure *)
190
182
···
192
184
(** [lookup_raw client acct] performs a Webfinger lookup returning the raw
193
185
[Webfinger.Jrd.t] from the webfinger library.
194
186
195
-
This is more efficient when you only need to extract specific fields
196
-
and don't need the full {!Proto.Webfinger.t} type.
187
+
This is more efficient when you only need to extract specific fields and
188
+
don't need the full {!Proto.Webfinger.t} type.
197
189
198
190
@raise E on lookup failure *)
199
191
200
192
val actor_uri : Proto.Webfinger.t -> Uri.t option
201
-
(** [actor_uri jrd] extracts the ActivityPub actor URI from a Webfinger response.
193
+
(** [actor_uri jrd] extracts the ActivityPub actor URI from a Webfinger
194
+
response.
202
195
203
196
Looks for a link with [rel="self"] and [type="application/activity+json"]
204
197
or [type="application/ld+json; profile=..."].
···
212
205
More efficient variant that works directly with {!Webfinger.Jrd.t}. *)
213
206
214
207
val profile_page : Proto.Webfinger.t -> Uri.t option
215
-
(** [profile_page jrd] extracts the HTML profile page URI from a Webfinger response.
208
+
(** [profile_page jrd] extracts the HTML profile page URI from a Webfinger
209
+
response.
216
210
217
211
Looks for [rel="http://webfinger.net/rel/profile-page"]. *)
218
212
219
213
val subscribe_template : Proto.Webfinger.t -> string option
220
214
(** [subscribe_template jrd] extracts the subscribe/follow template URI.
221
215
222
-
Looks for [rel="http://ostatus.org/schema/1.0/subscribe"].
223
-
This is used for remote follow buttons. The template contains [{uri}]
224
-
which should be replaced with the actor to follow. *)
216
+
Looks for [rel="http://ostatus.org/schema/1.0/subscribe"]. This is used
217
+
for remote follow buttons. The template contains [{uri}] which should be
218
+
replaced with the actor to follow. *)
225
219
end
226
220
227
221
(** {1 NodeInfo Discovery} *)
···
238
232
@raise E on fetch failure *)
239
233
240
234
val software_name : Proto.Nodeinfo.t -> string
241
-
(** [software_name info] returns the server software name (e.g., "mastodon", "pleroma"). *)
235
+
(** [software_name info] returns the server software name (e.g., "mastodon",
236
+
"pleroma"). *)
242
237
243
238
val software_version : Proto.Nodeinfo.t -> string
244
239
(** [software_version info] returns the server software version. *)
245
240
246
241
val supports_activitypub : Proto.Nodeinfo.t -> bool
247
-
(** [supports_activitypub info] returns [true] if the server supports ActivityPub. *)
242
+
(** [supports_activitypub info] returns [true] if the server supports
243
+
ActivityPub. *)
248
244
end
249
245
250
246
(** {1 Actor Operations} *)
···
300
296
301
297
(** {2 Follow/Unfollow} *)
302
298
303
-
val follow : t -> actor:Proto.Actor.t -> target:Proto.Actor.t -> Proto.Activity.t
299
+
val follow :
300
+
t -> actor:Proto.Actor.t -> target:Proto.Actor.t -> Proto.Activity.t
304
301
(** [follow client ~actor ~target] creates and sends a Follow activity.
305
302
306
303
The [actor] is the local actor performing the follow (requires signing).
···
308
305
309
306
@raise E on send failure *)
310
307
311
-
val unfollow : t -> actor:Proto.Actor.t -> target:Proto.Actor.t -> Proto.Activity.t
312
-
(** [unfollow client ~actor ~target] creates and sends an Undo(Follow) activity.
308
+
val unfollow :
309
+
t -> actor:Proto.Actor.t -> target:Proto.Actor.t -> Proto.Activity.t
310
+
(** [unfollow client ~actor ~target] creates and sends an Undo(Follow)
311
+
activity.
313
312
314
313
@raise E on send failure *)
315
314
316
315
val accept_follow :
317
-
t ->
318
-
actor:Proto.Actor.t ->
319
-
follow:Proto.Activity.t ->
320
-
Proto.Activity.t
316
+
t -> actor:Proto.Actor.t -> follow:Proto.Activity.t -> Proto.Activity.t
321
317
(** [accept_follow client ~actor ~follow] accepts an incoming Follow request.
322
318
323
319
@raise E on send failure *)
324
320
325
321
val reject_follow :
326
-
t ->
327
-
actor:Proto.Actor.t ->
328
-
follow:Proto.Activity.t ->
329
-
Proto.Activity.t
322
+
t -> actor:Proto.Actor.t -> follow:Proto.Activity.t -> Proto.Activity.t
330
323
(** [reject_follow client ~actor ~follow] rejects an incoming Follow request.
331
324
332
325
@raise E on send failure *)
···
359
352
@raise E on delivery failure *)
360
353
361
354
val post_to_actor : t -> Proto.Actor.t -> Proto.Activity.t -> unit
362
-
(** [post_to_actor client actor activity] delivers an activity to an actor's inbox.
355
+
(** [post_to_actor client actor activity] delivers an activity to an actor's
356
+
inbox.
363
357
364
358
Equivalent to [post client ~inbox:(Actor.inbox client actor) activity].
365
359
366
360
@raise E on delivery failure *)
367
361
368
-
val post_to_shared_inbox :
369
-
t ->
370
-
host:string ->
371
-
Proto.Activity.t ->
372
-
unit
373
-
(** [post_to_shared_inbox client ~host activity] delivers to a server's shared inbox.
362
+
val post_to_shared_inbox : t -> host:string -> Proto.Activity.t -> unit
363
+
(** [post_to_shared_inbox client ~host activity] delivers to a server's shared
364
+
inbox.
374
365
375
-
Uses the shared inbox from the server's NodeInfo if available,
376
-
otherwise falls back to individual inboxes.
366
+
Uses the shared inbox from the server's NodeInfo if available, otherwise
367
+
falls back to individual inboxes.
377
368
378
369
@raise E on delivery failure *)
379
370
end
···
395
386
content:string ->
396
387
unit ->
397
388
Proto.Activity.t
398
-
(** [create_note client ~actor ?in_reply_to ?to_ ?cc ?sensitive ?summary ~content ()]
399
-
creates and sends a Create(Note) activity.
389
+
(** [create_note client ~actor ?in_reply_to ?to_ ?cc ?sensitive ?summary
390
+
~content ()] creates and sends a Create(Note) activity.
400
391
401
392
@param actor The local actor creating the note
402
393
@param in_reply_to URI of note being replied to
···
414
405
content:string ->
415
406
unit ->
416
407
Proto.Activity.t
417
-
(** [public_note client ~actor ?in_reply_to ~content ()] creates a public note.
408
+
(** [public_note client ~actor ?in_reply_to ~content ()] creates a public
409
+
note.
418
410
419
-
Shorthand for {!create_note} with [to_] set to the public collection
420
-
and [cc] set to the actor's followers.
411
+
Shorthand for {!create_note} with [to_] set to the public collection and
412
+
[cc] set to the actor's followers.
421
413
422
414
@raise E on send failure *)
423
415
···
428
420
content:string ->
429
421
unit ->
430
422
Proto.Activity.t
431
-
(** [followers_only_note client ~actor ?in_reply_to ~content ()] creates
432
-
a followers-only note.
423
+
(** [followers_only_note client ~actor ?in_reply_to ~content ()] creates a
424
+
followers-only note.
433
425
434
426
@raise E on send failure *)
435
427
···
441
433
content:string ->
442
434
unit ->
443
435
Proto.Activity.t
444
-
(** [direct_note client ~actor ~to_ ?in_reply_to ~content ()] creates
445
-
a direct message to specific recipients.
436
+
(** [direct_note client ~actor ~to_ ?in_reply_to ~content ()] creates a direct
437
+
message to specific recipients.
446
438
447
439
@raise E on send failure *)
448
440
···
495
487
496
488
(** Utilities for iterating over paginated collections. *)
497
489
module Collection : sig
498
-
val iter :
499
-
t ->
500
-
('a -> unit) ->
501
-
'a Proto.Collection.t ->
502
-
'a Json.codec ->
503
-
unit
504
-
(** [iter client f collection item_jsont] iterates over all items in a collection,
505
-
automatically fetching subsequent pages.
490
+
val iter : t -> ('a -> unit) -> 'a Proto.Collection.t -> 'a Json.codec -> unit
491
+
(** [iter client f collection item_jsont] iterates over all items in a
492
+
collection, automatically fetching subsequent pages.
506
493
507
494
@raise E on fetch failure *)
508
495
···
513
500
'a Proto.Collection.t ->
514
501
'a Json.codec ->
515
502
'acc
516
-
(** [fold client f init collection item_jsont] folds over all items in a collection,
517
-
automatically fetching subsequent pages.
503
+
(** [fold client f init collection item_jsont] folds over all items in a
504
+
collection, automatically fetching subsequent pages.
518
505
519
506
@raise E on fetch failure *)
520
507
521
-
val to_list :
522
-
t ->
523
-
'a Proto.Collection.t ->
524
-
'a Json.codec ->
525
-
'a list
526
-
(** [to_list client collection item_jsont] returns all items in a collection as a list.
508
+
val to_list : t -> 'a Proto.Collection.t -> 'a Json.codec -> 'a list
509
+
(** [to_list client collection item_jsont] returns all items in a collection
510
+
as a list.
527
511
528
512
Warning: This may perform many HTTP requests for large collections.
529
513
···
534
518
'a Proto.Collection.t ->
535
519
'a Json.codec ->
536
520
'a Proto.Collection_page.t option
537
-
(** [first_page client collection item_jsont] fetches the first page of a collection.
521
+
(** [first_page client collection item_jsont] fetches the first page of a
522
+
collection.
538
523
539
524
@raise E on fetch failure *)
540
525
+8
-1
lib/client/dune
+8
-1
lib/client/dune
+681
-392
lib/proto/apubt_proto.ml
+681
-392
lib/proto/apubt_proto.ml
···
5
5
6
6
@see <https://www.w3.org/TR/activitypub/> ActivityPub specification
7
7
@see <https://www.w3.org/TR/activitystreams-core/> ActivityStreams Core
8
-
@see <https://www.w3.org/TR/activitystreams-vocabulary/> ActivityStreams Vocabulary *)
8
+
@see <https://www.w3.org/TR/activitystreams-vocabulary/>
9
+
ActivityStreams Vocabulary *)
9
10
10
11
(** {1 Common Types} *)
11
12
12
13
(** Timestamps in ISO 8601 format. *)
13
14
module Datetime : sig
14
15
type t
16
+
15
17
val v : string -> t
16
18
val to_string : t -> string
17
19
val jsont : t Json.codec
18
20
end = struct
19
21
type t = string
22
+
20
23
let v s = s
21
24
let to_string t = t
22
25
let jsont = Json.Codec.string |> Json.Codec.with_doc ~kind:"datetime"
···
29
32
(** JSON-LD context. *)
30
33
module Context : sig
31
34
type t
35
+
32
36
val default : t
33
37
val jsont : t Json.codec
34
38
end = struct
35
39
type t = Json.t
36
-
let default =
37
-
Json.Value.string "https://www.w3.org/ns/activitystreams"
40
+
41
+
let default = Json.Value.string "https://www.w3.org/ns/activitystreams"
38
42
let jsont = Json.Codec.Value.t |> Json.Codec.with_doc ~kind:"@context"
39
43
end
40
44
41
-
(** Helper: JSON type that accepts either a single item or an array, normalizing to a list.
42
-
On encoding, always outputs an array for consistency. *)
45
+
(** Helper: JSON type that accepts either a single item or an array, normalizing
46
+
to a list. On encoding, always outputs an array for consistency. *)
43
47
let one_or_many (item_jsont : 'a Json.codec) : 'a list Json.codec =
44
48
let dec_array = Json.Codec.list item_jsont in
45
-
let dec_single = Json.Codec.map item_jsont
46
-
~dec:(fun x -> [x])
47
-
~enc:(fun _ -> assert false) (* never used for encoding *)
49
+
let dec_single =
50
+
Json.Codec.map item_jsont ~dec:(fun x -> [ x ]) ~enc:(fun _ -> assert false)
51
+
(* never used for encoding *)
48
52
in
49
-
Json.Codec.any ~kind:"one or many"
50
-
~dec_array
51
-
~dec_string:dec_single
53
+
Json.Codec.any ~kind:"one or many" ~dec_array ~dec_string:dec_single
52
54
~dec_object:dec_single
53
55
~enc:(fun _ -> dec_array) (* always encode as array *)
54
56
()
···
56
58
(** Helper: Nullable value - accepts null as None, value as Some value *)
57
59
let nullable (jsont : 'a Json.codec) : 'a option Json.codec =
58
60
let dec_null = Json.Codec.null None in
59
-
let dec_value = Json.Codec.map jsont
61
+
let dec_value =
62
+
Json.Codec.map jsont
60
63
~dec:(fun v -> Some v)
61
64
~enc:(function Some v -> v | None -> assert false)
62
65
in
63
-
Json.Codec.any ~kind:"nullable"
64
-
~dec_null
65
-
~dec_string:dec_value
66
-
~dec_number:dec_value
67
-
~dec_bool:dec_value
68
-
~dec_array:dec_value
66
+
Json.Codec.any ~kind:"nullable" ~dec_null ~dec_string:dec_value
67
+
~dec_number:dec_value ~dec_bool:dec_value ~dec_array:dec_value
69
68
~dec_object:dec_value
70
-
~enc:(function
71
-
| None -> dec_null
72
-
| Some _ -> dec_value)
69
+
~enc:(function None -> dec_null | Some _ -> dec_value)
73
70
()
74
71
75
-
(** Helper: URI that can also be an object with an id field.
76
-
This handles ActivityPub fields like 'replies' that can be either
77
-
a URI string or an inline Collection object. *)
72
+
(** Helper: URI that can also be an object with an id field. This handles
73
+
ActivityPub fields like 'replies' that can be either a URI string or an
74
+
inline Collection object. *)
78
75
let uri_or_object_with_id : Uri.t Json.codec =
79
76
let id_jsont =
80
77
Json.Codec.Object.map ~kind:"Object with id" (fun id -> id)
81
78
|> Json.Codec.Object.member "id" uri_jsont ~enc:Fun.id
82
-
|> Json.Codec.Object.skip_unknown
83
-
|> Json.Codec.Object.seal
79
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
84
80
in
85
-
Json.Codec.any ~kind:"URI or object"
86
-
~dec_string:uri_jsont
81
+
Json.Codec.any ~kind:"URI or object" ~dec_string:uri_jsont
87
82
~dec_object:id_jsont
88
83
~enc:(fun _ -> uri_jsont)
89
84
()
90
85
91
-
92
86
(** {1 Link} *)
93
87
94
88
(** Link objects represent references to other resources.
···
104
98
?width:int ->
105
99
?preview:Uri.t ->
106
100
href:Uri.t ->
107
-
unit -> t
101
+
unit ->
102
+
t
108
103
109
104
val href : t -> Uri.t
110
105
val media_type : t -> string option
···
113
108
val height : t -> int option
114
109
val width : t -> int option
115
110
val preview : t -> Uri.t option
116
-
117
111
val jsont : t Json.codec
118
112
end = struct
119
113
type t = {
···
140
134
let jsont =
141
135
Json.Codec.Object.map ~kind:"Link"
142
136
(fun href media_type name hreflang height width preview ->
143
-
{ href; media_type; name; hreflang; height; width; preview })
137
+
{ href; media_type; name; hreflang; height; width; preview })
144
138
|> Json.Codec.Object.member "href" uri_jsont ~enc:href
145
-
|> Json.Codec.Object.opt_member "mediaType" Json.Codec.string ~enc:media_type
139
+
|> Json.Codec.Object.opt_member "mediaType" Json.Codec.string
140
+
~enc:media_type
146
141
|> Json.Codec.Object.opt_member "name" Json.Codec.string ~enc:name
147
142
|> Json.Codec.Object.opt_member "hreflang" Json.Codec.string ~enc:hreflang
148
143
|> Json.Codec.Object.opt_member "height" Json.Codec.int ~enc:height
···
153
148
154
149
(** Reference that can be either a URI string or a Link object. *)
155
150
module Link_or_uri : sig
156
-
type t =
157
-
| Uri of Uri.t
158
-
| Link of Link.t
151
+
type t = Uri of Uri.t | Link of Link.t
159
152
160
153
val uri : Uri.t -> t
161
154
val link : Link.t -> t
162
155
val jsont : t Json.codec
163
156
end = struct
164
-
type t =
165
-
| Uri of Uri.t
166
-
| Link of Link.t
157
+
type t = Uri of Uri.t | Link of Link.t
167
158
168
159
let uri u = Uri u
169
160
let link l = Link l
170
161
171
162
let jsont =
172
-
let dec_string = Json.Codec.map uri_jsont ~dec:(fun u -> Uri u)
173
-
~enc:(function Uri u -> u | Link _ -> assert false) in
174
-
let dec_object = Json.Codec.map Link.jsont ~dec:(fun l -> Link l)
175
-
~enc:(function Link l -> l | Uri _ -> assert false) in
176
-
Json.Codec.any ~kind:"Link or URI"
177
-
~dec_string ~dec_object
178
-
~enc:(function
179
-
| Uri _ -> dec_string
180
-
| Link _ -> dec_object)
163
+
let dec_string =
164
+
Json.Codec.map uri_jsont
165
+
~dec:(fun u -> Uri u)
166
+
~enc:(function Uri u -> u | Link _ -> assert false)
167
+
in
168
+
let dec_object =
169
+
Json.Codec.map Link.jsont
170
+
~dec:(fun l -> Link l)
171
+
~enc:(function Link l -> l | Uri _ -> assert false)
172
+
in
173
+
Json.Codec.any ~kind:"Link or URI" ~dec_string ~dec_object
174
+
~enc:(function Uri _ -> dec_string | Link _ -> dec_object)
181
175
()
182
176
end
183
177
···
195
189
?width:int ->
196
190
?height:int ->
197
191
url:Link_or_uri.t ->
198
-
unit -> t
192
+
unit ->
193
+
t
199
194
200
195
val id : t -> Uri.t option
201
196
val url : t -> Link_or_uri.t
···
203
198
val media_type : t -> string option
204
199
val width : t -> int option
205
200
val height : t -> int option
206
-
207
201
val jsont : t Json.codec
208
202
end = struct
209
203
type t = {
···
228
222
let jsont =
229
223
Json.Codec.Object.map ~kind:"Image"
230
224
(fun id url name media_type width height ->
231
-
{ id; url; name; media_type; width; height })
225
+
{ id; url; name; media_type; width; height })
232
226
|> Json.Codec.Object.opt_member "id" uri_jsont ~enc:id
233
227
|> Json.Codec.Object.member "url" Link_or_uri.jsont ~enc:url
234
228
|> Json.Codec.Object.opt_member "name" Json.Codec.string ~enc:name
235
-
|> Json.Codec.Object.opt_member "mediaType" Json.Codec.string ~enc:media_type
229
+
|> Json.Codec.Object.opt_member "mediaType" Json.Codec.string
230
+
~enc:media_type
236
231
|> Json.Codec.Object.opt_member "width" Json.Codec.int ~enc:width
237
232
|> Json.Codec.Object.opt_member "height" Json.Codec.int ~enc:height
238
233
|> Json.Codec.Object.seal
···
240
235
241
236
(** Image reference - can be URI, Link, or full Image object. *)
242
237
module Image_ref : sig
243
-
type t =
244
-
| Uri of Uri.t
245
-
| Link of Link.t
246
-
| Image of Image.t
238
+
type t = Uri of Uri.t | Link of Link.t | Image of Image.t
247
239
248
240
val uri : Uri.t -> t
249
241
val link : Link.t -> t
250
242
val image : Image.t -> t
251
243
val jsont : t Json.codec
252
244
end = struct
253
-
type t =
254
-
| Uri of Uri.t
255
-
| Link of Link.t
256
-
| Image of Image.t
245
+
type t = Uri of Uri.t | Link of Link.t | Image of Image.t
257
246
258
247
let uri u = Uri u
259
248
let link l = Link l
···
261
250
262
251
let jsont =
263
252
(* For string case: URI *)
264
-
let dec_string = Json.Codec.map uri_jsont ~dec:(fun u -> Uri u)
265
-
~enc:(function Uri u -> u | _ -> assert false) in
253
+
let dec_string =
254
+
Json.Codec.map uri_jsont
255
+
~dec:(fun u -> Uri u)
256
+
~enc:(function Uri u -> u | _ -> assert false)
257
+
in
266
258
(* For object case: either Link or Image *)
267
259
let dec_object =
268
260
(* Default: decode as Image if we can't determine type *)
···
270
262
~dec:(fun i -> Image i)
271
263
~enc:(function Image i -> i | _ -> assert false)
272
264
in
273
-
Json.Codec.any ~kind:"Image reference"
274
-
~dec_string ~dec_object
275
-
~enc:(function
276
-
| Uri _ -> dec_string
277
-
| Link _ | Image _ -> dec_object)
265
+
Json.Codec.any ~kind:"Image reference" ~dec_string ~dec_object
266
+
~enc:(function Uri _ -> dec_string | Link _ | Image _ -> dec_object)
278
267
()
279
268
end
280
269
···
291
280
292
281
(** Recipient reference - can be URI or inline object with id and type. *)
293
282
module Recipient : sig
294
-
type t = {
295
-
id : Uri.t;
296
-
type_ : string option;
297
-
}
283
+
type t = { id : Uri.t; type_ : string option }
298
284
299
285
val make : ?type_:string -> Uri.t -> t
300
286
val id : t -> Uri.t
301
287
val type_ : t -> string option
302
288
val jsont : t Json.codec
303
289
end = struct
304
-
type t = {
305
-
id : Uri.t;
306
-
type_ : string option;
307
-
}
290
+
type t = { id : Uri.t; type_ : string option }
308
291
309
292
let make ?type_ id = { id; type_ }
310
293
let id t = t.id
311
294
let type_ t = t.type_
312
295
313
296
let jsont =
314
-
let dec_string = Json.Codec.map uri_jsont
297
+
let dec_string =
298
+
Json.Codec.map uri_jsont
315
299
~dec:(fun u -> { id = u; type_ = None })
316
-
~enc:(fun t -> t.id) in
300
+
~enc:(fun t -> t.id)
301
+
in
317
302
let dec_object =
318
-
Json.Codec.Object.map ~kind:"Recipient"
319
-
(fun id type_ -> { id; type_ })
303
+
Json.Codec.Object.map ~kind:"Recipient" (fun id type_ -> { id; type_ })
320
304
|> Json.Codec.Object.member "id" uri_jsont ~enc:id
321
305
|> Json.Codec.Object.opt_member "type" Json.Codec.string ~enc:type_
322
306
|> Json.Codec.Object.seal
323
307
in
324
-
Json.Codec.any ~kind:"Recipient"
325
-
~dec_string ~dec_object
308
+
Json.Codec.any ~kind:"Recipient" ~dec_string ~dec_object
326
309
~enc:(fun t ->
327
-
match t.type_ with
328
-
| None -> dec_string
329
-
| Some _ -> dec_object)
310
+
match t.type_ with None -> dec_string | Some _ -> dec_object)
330
311
()
331
312
end
332
313
···
343
324
?provide_client_key:Uri.t ->
344
325
?sign_client_key:Uri.t ->
345
326
?shared_inbox:Uri.t ->
346
-
unit -> t
327
+
unit ->
328
+
t
347
329
348
330
val proxy_url : t -> Uri.t option
349
331
val oauth_authorization_endpoint : t -> Uri.t option
···
351
333
val provide_client_key : t -> Uri.t option
352
334
val sign_client_key : t -> Uri.t option
353
335
val shared_inbox : t -> Uri.t option
354
-
355
336
val jsont : t Json.codec
356
337
end = struct
357
338
type t = {
···
365
346
366
347
let make ?proxy_url ?oauth_authorization_endpoint ?oauth_token_endpoint
367
348
?provide_client_key ?sign_client_key ?shared_inbox () =
368
-
{ proxy_url; oauth_authorization_endpoint; oauth_token_endpoint;
369
-
provide_client_key; sign_client_key; shared_inbox }
349
+
{
350
+
proxy_url;
351
+
oauth_authorization_endpoint;
352
+
oauth_token_endpoint;
353
+
provide_client_key;
354
+
sign_client_key;
355
+
shared_inbox;
356
+
}
370
357
371
358
let proxy_url t = t.proxy_url
372
359
let oauth_authorization_endpoint t = t.oauth_authorization_endpoint
···
377
364
378
365
let jsont =
379
366
Json.Codec.Object.map ~kind:"Endpoints"
380
-
(fun proxy_url oauth_authorization_endpoint oauth_token_endpoint
381
-
provide_client_key sign_client_key shared_inbox ->
382
-
{ proxy_url; oauth_authorization_endpoint; oauth_token_endpoint;
383
-
provide_client_key; sign_client_key; shared_inbox })
367
+
(fun
368
+
proxy_url
369
+
oauth_authorization_endpoint
370
+
oauth_token_endpoint
371
+
provide_client_key
372
+
sign_client_key
373
+
shared_inbox
374
+
->
375
+
{
376
+
proxy_url;
377
+
oauth_authorization_endpoint;
378
+
oauth_token_endpoint;
379
+
provide_client_key;
380
+
sign_client_key;
381
+
shared_inbox;
382
+
})
384
383
|> Json.Codec.Object.opt_member "proxyUrl" uri_jsont ~enc:proxy_url
385
384
|> Json.Codec.Object.opt_member "oauthAuthorizationEndpoint" uri_jsont
386
-
~enc:oauth_authorization_endpoint
385
+
~enc:oauth_authorization_endpoint
387
386
|> Json.Codec.Object.opt_member "oauthTokenEndpoint" uri_jsont
388
-
~enc:oauth_token_endpoint
389
-
|> Json.Codec.Object.opt_member "provideClientKey" uri_jsont ~enc:provide_client_key
390
-
|> Json.Codec.Object.opt_member "signClientKey" uri_jsont ~enc:sign_client_key
387
+
~enc:oauth_token_endpoint
388
+
|> Json.Codec.Object.opt_member "provideClientKey" uri_jsont
389
+
~enc:provide_client_key
390
+
|> Json.Codec.Object.opt_member "signClientKey" uri_jsont
391
+
~enc:sign_client_key
391
392
|> Json.Codec.Object.opt_member "sharedInbox" uri_jsont ~enc:shared_inbox
392
393
|> Json.Codec.Object.seal
393
394
end
···
398
399
module Public_key : sig
399
400
type t
400
401
401
-
val make :
402
-
id:Uri.t ->
403
-
owner:Uri.t ->
404
-
public_key_pem:string ->
405
-
unit -> t
406
-
402
+
val make : id:Uri.t -> owner:Uri.t -> public_key_pem:string -> unit -> t
407
403
val id : t -> Uri.t
408
404
val owner : t -> Uri.t
409
405
val public_key_pem : t -> string
410
-
411
406
val jsont : t Json.codec
412
407
end = struct
413
-
type t = {
414
-
id : Uri.t;
415
-
owner : Uri.t;
416
-
public_key_pem : string;
417
-
}
408
+
type t = { id : Uri.t; owner : Uri.t; public_key_pem : string }
418
409
419
-
let make ~id ~owner ~public_key_pem () =
420
-
{ id; owner; public_key_pem }
421
-
410
+
let make ~id ~owner ~public_key_pem () = { id; owner; public_key_pem }
422
411
let id t = t.id
423
412
let owner t = t.owner
424
413
let public_key_pem t = t.public_key_pem
425
414
426
415
let jsont =
427
-
Json.Codec.Object.map ~kind:"PublicKey"
428
-
(fun id owner public_key_pem -> { id; owner; public_key_pem })
416
+
Json.Codec.Object.map ~kind:"PublicKey" (fun id owner public_key_pem ->
417
+
{ id; owner; public_key_pem })
429
418
|> Json.Codec.Object.member "id" uri_jsont ~enc:id
430
419
|> Json.Codec.Object.member "owner" uri_jsont ~enc:owner
431
-
|> Json.Codec.Object.member "publicKeyPem" Json.Codec.string ~enc:public_key_pem
420
+
|> Json.Codec.Object.member "publicKeyPem" Json.Codec.string
421
+
~enc:public_key_pem
432
422
|> Json.Codec.Object.seal
433
423
end
434
424
···
436
426
437
427
(** Actor types enumeration. *)
438
428
module Actor_type : sig
439
-
type t =
440
-
| Person
441
-
| Service
442
-
| Organization
443
-
| Group
444
-
| Application
429
+
type t = Person | Service | Organization | Group | Application
445
430
446
431
val to_string : t -> string
447
432
val of_string : string -> t option
448
433
val jsont : t Json.codec
449
434
end = struct
450
-
type t =
451
-
| Person
452
-
| Service
453
-
| Organization
454
-
| Group
455
-
| Application
435
+
type t = Person | Service | Organization | Group | Application
456
436
457
437
let to_string = function
458
438
| Person -> "Person"
···
470
450
| _ -> None
471
451
472
452
let jsont =
473
-
Json.Codec.enum ~kind:"ActorType" [
474
-
"Person", Person;
475
-
"Service", Service;
476
-
"Organization", Organization;
477
-
"Group", Group;
478
-
"Application", Application;
479
-
]
453
+
Json.Codec.enum ~kind:"ActorType"
454
+
[
455
+
("Person", Person);
456
+
("Service", Service);
457
+
("Organization", Organization);
458
+
("Group", Group);
459
+
("Application", Application);
460
+
]
480
461
end
481
462
482
463
(** {1 Actor} *)
···
511
492
?moved_to:Uri.t ->
512
493
?featured:Uri.t ->
513
494
?featured_tags:Uri.t ->
514
-
unit -> t
495
+
unit ->
496
+
t
515
497
516
498
val context : t -> Context.t option
517
499
val id : t -> Uri.t
···
537
519
val moved_to : t -> Uri.t option
538
520
val featured : t -> Uri.t option
539
521
val featured_tags : t -> Uri.t option
540
-
541
522
val jsont : t Json.codec
542
523
end = struct
543
524
type t = {
···
567
548
featured_tags : Uri.t option;
568
549
}
569
550
570
-
let make ?context ~id ~type_ ?name ?preferred_username ?summary ?url
571
-
~inbox ~outbox ?followers ?following ?liked ?streams ?endpoints
572
-
?public_key ?icon ?image ?manually_approves_followers
573
-
?also_known_as ?discoverable ?suspended ?moved_to ?featured
574
-
?featured_tags () =
575
-
{ context; id; type_; name; preferred_username; summary; url;
576
-
inbox; outbox; followers; following; liked; streams; endpoints;
577
-
public_key; icon; image; manually_approves_followers;
578
-
also_known_as; discoverable; suspended; moved_to; featured;
579
-
featured_tags }
551
+
let make ?context ~id ~type_ ?name ?preferred_username ?summary ?url ~inbox
552
+
~outbox ?followers ?following ?liked ?streams ?endpoints ?public_key ?icon
553
+
?image ?manually_approves_followers ?also_known_as ?discoverable
554
+
?suspended ?moved_to ?featured ?featured_tags () =
555
+
{
556
+
context;
557
+
id;
558
+
type_;
559
+
name;
560
+
preferred_username;
561
+
summary;
562
+
url;
563
+
inbox;
564
+
outbox;
565
+
followers;
566
+
following;
567
+
liked;
568
+
streams;
569
+
endpoints;
570
+
public_key;
571
+
icon;
572
+
image;
573
+
manually_approves_followers;
574
+
also_known_as;
575
+
discoverable;
576
+
suspended;
577
+
moved_to;
578
+
featured;
579
+
featured_tags;
580
+
}
580
581
581
582
let context t = t.context
582
583
let id t = t.id
···
605
606
606
607
let jsont =
607
608
Json.Codec.Object.map ~kind:"Actor"
608
-
(fun context id type_ name preferred_username summary url inbox outbox
609
-
followers following liked streams endpoints public_key icon image
610
-
manually_approves_followers also_known_as discoverable suspended
611
-
moved_to featured featured_tags ->
612
-
{ context; id; type_; name; preferred_username; summary; url;
613
-
inbox; outbox; followers; following; liked; streams; endpoints;
614
-
public_key; icon; image; manually_approves_followers;
615
-
also_known_as; discoverable; suspended; moved_to; featured;
616
-
featured_tags })
609
+
(fun
610
+
context
611
+
id
612
+
type_
613
+
name
614
+
preferred_username
615
+
summary
616
+
url
617
+
inbox
618
+
outbox
619
+
followers
620
+
following
621
+
liked
622
+
streams
623
+
endpoints
624
+
public_key
625
+
icon
626
+
image
627
+
manually_approves_followers
628
+
also_known_as
629
+
discoverable
630
+
suspended
631
+
moved_to
632
+
featured
633
+
featured_tags
634
+
->
635
+
{
636
+
context;
637
+
id;
638
+
type_;
639
+
name;
640
+
preferred_username;
641
+
summary;
642
+
url;
643
+
inbox;
644
+
outbox;
645
+
followers;
646
+
following;
647
+
liked;
648
+
streams;
649
+
endpoints;
650
+
public_key;
651
+
icon;
652
+
image;
653
+
manually_approves_followers;
654
+
also_known_as;
655
+
discoverable;
656
+
suspended;
657
+
moved_to;
658
+
featured;
659
+
featured_tags;
660
+
})
617
661
|> Json.Codec.Object.opt_member "@context" Context.jsont ~enc:context
618
662
|> Json.Codec.Object.member "id" uri_jsont ~enc:id
619
663
|> Json.Codec.Object.member "type" Actor_type.jsont ~enc:type_
620
664
|> Json.Codec.Object.opt_member "name" Json.Codec.string ~enc:name
621
665
|> Json.Codec.Object.opt_member "preferredUsername" Json.Codec.string
622
-
~enc:preferred_username
666
+
~enc:preferred_username
623
667
|> Json.Codec.Object.opt_member "summary" Json.Codec.string ~enc:summary
624
668
|> Json.Codec.Object.opt_member "url" uri_jsont ~enc:url
625
669
|> Json.Codec.Object.member "inbox" uri_jsont ~enc:inbox
···
627
671
|> Json.Codec.Object.opt_member "followers" uri_jsont ~enc:followers
628
672
|> Json.Codec.Object.opt_member "following" uri_jsont ~enc:following
629
673
|> Json.Codec.Object.opt_member "liked" uri_jsont ~enc:liked
630
-
|> Json.Codec.Object.opt_member "streams" (Json.Codec.list uri_jsont) ~enc:streams
674
+
|> Json.Codec.Object.opt_member "streams"
675
+
(Json.Codec.list uri_jsont)
676
+
~enc:streams
631
677
|> Json.Codec.Object.opt_member "endpoints" Endpoints.jsont ~enc:endpoints
632
678
|> Json.Codec.Object.opt_member "publicKey" Public_key.jsont ~enc:public_key
633
-
|> Json.Codec.Object.opt_member "icon" (one_or_many Image_ref.jsont) ~enc:icon
634
-
|> Json.Codec.Object.opt_member "image" (one_or_many Image_ref.jsont) ~enc:image
679
+
|> Json.Codec.Object.opt_member "icon"
680
+
(one_or_many Image_ref.jsont)
681
+
~enc:icon
682
+
|> Json.Codec.Object.opt_member "image"
683
+
(one_or_many Image_ref.jsont)
684
+
~enc:image
635
685
|> Json.Codec.Object.opt_member "manuallyApprovesFollowers" Json.Codec.bool
636
-
~enc:manually_approves_followers
686
+
~enc:manually_approves_followers
637
687
|> Json.Codec.Object.opt_member "alsoKnownAs" (one_or_many uri_jsont)
638
-
~enc:also_known_as
639
-
|> Json.Codec.Object.opt_member "discoverable" Json.Codec.bool ~enc:discoverable
688
+
~enc:also_known_as
689
+
|> Json.Codec.Object.opt_member "discoverable" Json.Codec.bool
690
+
~enc:discoverable
640
691
|> Json.Codec.Object.opt_member "suspended" Json.Codec.bool ~enc:suspended
641
692
|> Json.Codec.Object.opt_member "movedTo" uri_jsont ~enc:moved_to
642
693
|> Json.Codec.Object.opt_member "featured" uri_jsont ~enc:featured
···
646
697
647
698
(** Actor reference - can be URI or full Actor object. *)
648
699
module Actor_ref : sig
649
-
type t =
650
-
| Uri of Uri.t
651
-
| Actor of Actor.t
700
+
type t = Uri of Uri.t | Actor of Actor.t
652
701
653
702
val uri : Uri.t -> t
654
703
val actor : Actor.t -> t
655
704
val jsont : t Json.codec
656
705
end = struct
657
-
type t =
658
-
| Uri of Uri.t
659
-
| Actor of Actor.t
706
+
type t = Uri of Uri.t | Actor of Actor.t
660
707
661
708
let uri u = Uri u
662
709
let actor a = Actor a
663
710
664
711
let jsont =
665
-
let dec_string = Json.Codec.map uri_jsont
712
+
let dec_string =
713
+
Json.Codec.map uri_jsont
666
714
~dec:(fun u -> Uri u)
667
-
~enc:(function Uri u -> u | Actor _ -> assert false) in
668
-
let dec_object = Json.Codec.map Actor.jsont
715
+
~enc:(function Uri u -> u | Actor _ -> assert false)
716
+
in
717
+
let dec_object =
718
+
Json.Codec.map Actor.jsont
669
719
~dec:(fun a -> Actor a)
670
-
~enc:(function Actor a -> a | Uri _ -> assert false) in
671
-
Json.Codec.any ~kind:"Actor reference"
672
-
~dec_string ~dec_object
673
-
~enc:(function
674
-
| Uri _ -> dec_string
675
-
| Actor _ -> dec_object)
720
+
~enc:(function Actor a -> a | Uri _ -> assert false)
721
+
in
722
+
Json.Codec.any ~kind:"Actor reference" ~dec_string ~dec_object
723
+
~enc:(function Uri _ -> dec_string | Actor _ -> dec_object)
676
724
()
677
725
end
678
726
···
746
794
| _ -> None
747
795
748
796
let jsont =
749
-
Json.Codec.enum ~kind:"ObjectType" [
750
-
"Note", Note;
751
-
"Article", Article;
752
-
"Page", Page;
753
-
"Event", Event;
754
-
"Image", Image;
755
-
"Video", Video;
756
-
"Audio", Audio;
757
-
"Document", Document;
758
-
"Place", Place;
759
-
"Profile", Profile;
760
-
"Tombstone", Tombstone;
761
-
"Collection", Collection;
762
-
"OrderedCollection", OrderedCollection;
763
-
]
797
+
Json.Codec.enum ~kind:"ObjectType"
798
+
[
799
+
("Note", Note);
800
+
("Article", Article);
801
+
("Page", Page);
802
+
("Event", Event);
803
+
("Image", Image);
804
+
("Video", Video);
805
+
("Audio", Audio);
806
+
("Document", Document);
807
+
("Place", Place);
808
+
("Profile", Profile);
809
+
("Tombstone", Tombstone);
810
+
("Collection", Collection);
811
+
("OrderedCollection", OrderedCollection);
812
+
]
764
813
end
765
814
766
815
(** {1 Object} *)
···
802
851
?audience:Recipient.t list ->
803
852
?location:Link_or_uri.t ->
804
853
?preview:Link_or_uri.t ->
805
-
unit -> t
854
+
unit ->
855
+
t
806
856
(** Create a new Object. *)
807
857
808
858
val context : t -> Context.t option
···
836
886
val audience : t -> Recipient.t list option
837
887
838
888
val location : t -> Link_or_uri.t option
839
-
(** [location t] returns the physical or logical location associated with the object. *)
889
+
(** [location t] returns the physical or logical location associated with the
890
+
object. *)
840
891
841
892
val preview : t -> Link_or_uri.t option
842
-
(** [preview t] returns a preview of the object, typically a smaller version. *)
893
+
(** [preview t] returns a preview of the object, typically a smaller version.
894
+
*)
843
895
844
896
val jsont : t Json.codec
845
897
(** JSON type for Objects. *)
···
879
931
}
880
932
881
933
let make ?context ?id ~type_ ?name ?summary ?content ?media_type ?url
882
-
?attributed_to ?in_reply_to ?published ?updated ?deleted ?to_ ?cc
883
-
?bto ?bcc ?replies ?attachment ?tag ?generator ?icon ?image
884
-
?start_time ?end_time ?duration ?sensitive ?conversation ?audience
885
-
?location ?preview () =
886
-
{ context; id; type_; name; summary; content; media_type; url;
887
-
attributed_to; in_reply_to; published; updated; deleted;
888
-
to_; cc; bto; bcc; replies; attachment; tag; generator;
889
-
icon; image; start_time; end_time; duration; sensitive;
890
-
conversation; audience; location; preview }
934
+
?attributed_to ?in_reply_to ?published ?updated ?deleted ?to_ ?cc ?bto
935
+
?bcc ?replies ?attachment ?tag ?generator ?icon ?image ?start_time
936
+
?end_time ?duration ?sensitive ?conversation ?audience ?location ?preview
937
+
() =
938
+
{
939
+
context;
940
+
id;
941
+
type_;
942
+
name;
943
+
summary;
944
+
content;
945
+
media_type;
946
+
url;
947
+
attributed_to;
948
+
in_reply_to;
949
+
published;
950
+
updated;
951
+
deleted;
952
+
to_;
953
+
cc;
954
+
bto;
955
+
bcc;
956
+
replies;
957
+
attachment;
958
+
tag;
959
+
generator;
960
+
icon;
961
+
image;
962
+
start_time;
963
+
end_time;
964
+
duration;
965
+
sensitive;
966
+
conversation;
967
+
audience;
968
+
location;
969
+
preview;
970
+
}
891
971
892
972
let context t = t.context
893
973
let id t = t.id
···
923
1003
924
1004
let jsont =
925
1005
Json.Codec.Object.map ~kind:"Object"
926
-
(fun context id type_ name summary content media_type url attributed_to
927
-
in_reply_to published updated deleted to_ cc bto bcc replies
928
-
attachment tag generator icon image start_time end_time duration
929
-
sensitive conversation audience location preview ->
930
-
{ context; id; type_; name; summary; content; media_type; url;
931
-
attributed_to; in_reply_to; published; updated; deleted;
932
-
to_; cc; bto; bcc; replies; attachment; tag; generator;
933
-
icon; image; start_time; end_time; duration; sensitive;
934
-
conversation; audience; location; preview })
1006
+
(fun
1007
+
context
1008
+
id
1009
+
type_
1010
+
name
1011
+
summary
1012
+
content
1013
+
media_type
1014
+
url
1015
+
attributed_to
1016
+
in_reply_to
1017
+
published
1018
+
updated
1019
+
deleted
1020
+
to_
1021
+
cc
1022
+
bto
1023
+
bcc
1024
+
replies
1025
+
attachment
1026
+
tag
1027
+
generator
1028
+
icon
1029
+
image
1030
+
start_time
1031
+
end_time
1032
+
duration
1033
+
sensitive
1034
+
conversation
1035
+
audience
1036
+
location
1037
+
preview
1038
+
->
1039
+
{
1040
+
context;
1041
+
id;
1042
+
type_;
1043
+
name;
1044
+
summary;
1045
+
content;
1046
+
media_type;
1047
+
url;
1048
+
attributed_to;
1049
+
in_reply_to;
1050
+
published;
1051
+
updated;
1052
+
deleted;
1053
+
to_;
1054
+
cc;
1055
+
bto;
1056
+
bcc;
1057
+
replies;
1058
+
attachment;
1059
+
tag;
1060
+
generator;
1061
+
icon;
1062
+
image;
1063
+
start_time;
1064
+
end_time;
1065
+
duration;
1066
+
sensitive;
1067
+
conversation;
1068
+
audience;
1069
+
location;
1070
+
preview;
1071
+
})
935
1072
|> Json.Codec.Object.opt_member "@context" Context.jsont ~enc:context
936
1073
|> Json.Codec.Object.opt_member "id" uri_jsont ~enc:id
937
1074
|> Json.Codec.Object.member "type" Object_type.jsont ~enc:type_
938
1075
|> Json.Codec.Object.opt_member "name" Json.Codec.string ~enc:name
939
-
|> Json.Codec.Object.member "summary" (nullable Json.Codec.string)
940
-
~dec_absent:None ~enc_omit:Option.is_none ~enc:summary
941
-
|> Json.Codec.Object.member "content" (nullable Json.Codec.string)
942
-
~dec_absent:None ~enc_omit:Option.is_none ~enc:content
943
-
|> Json.Codec.Object.opt_member "mediaType" Json.Codec.string ~enc:media_type
944
-
|> Json.Codec.Object.opt_member "url" (one_or_many Link_or_uri.jsont) ~enc:url
945
-
|> Json.Codec.Object.opt_member "attributedTo" Actor_ref.jsont ~enc:attributed_to
1076
+
|> Json.Codec.Object.member "summary"
1077
+
(nullable Json.Codec.string)
1078
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:summary
1079
+
|> Json.Codec.Object.member "content"
1080
+
(nullable Json.Codec.string)
1081
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:content
1082
+
|> Json.Codec.Object.opt_member "mediaType" Json.Codec.string
1083
+
~enc:media_type
1084
+
|> Json.Codec.Object.opt_member "url"
1085
+
(one_or_many Link_or_uri.jsont)
1086
+
~enc:url
1087
+
|> Json.Codec.Object.opt_member "attributedTo" Actor_ref.jsont
1088
+
~enc:attributed_to
946
1089
|> Json.Codec.Object.member "inReplyTo" (nullable uri_jsont)
947
-
~dec_absent:None ~enc_omit:Option.is_none ~enc:in_reply_to
1090
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:in_reply_to
948
1091
|> Json.Codec.Object.opt_member "published" Datetime.jsont ~enc:published
949
1092
|> Json.Codec.Object.opt_member "updated" Datetime.jsont ~enc:updated
950
1093
|> Json.Codec.Object.opt_member "deleted" Datetime.jsont ~enc:deleted
951
-
|> Json.Codec.Object.opt_member "to" (Json.Codec.list Recipient.jsont) ~enc:to_
952
-
|> Json.Codec.Object.opt_member "cc" (Json.Codec.list Recipient.jsont) ~enc:cc
953
-
|> Json.Codec.Object.opt_member "bto" (Json.Codec.list Recipient.jsont) ~enc:bto
954
-
|> Json.Codec.Object.opt_member "bcc" (Json.Codec.list Recipient.jsont) ~enc:bcc
1094
+
|> Json.Codec.Object.opt_member "to"
1095
+
(Json.Codec.list Recipient.jsont)
1096
+
~enc:to_
1097
+
|> Json.Codec.Object.opt_member "cc"
1098
+
(Json.Codec.list Recipient.jsont)
1099
+
~enc:cc
1100
+
|> Json.Codec.Object.opt_member "bto"
1101
+
(Json.Codec.list Recipient.jsont)
1102
+
~enc:bto
1103
+
|> Json.Codec.Object.opt_member "bcc"
1104
+
(Json.Codec.list Recipient.jsont)
1105
+
~enc:bcc
955
1106
|> Json.Codec.Object.opt_member "replies" uri_or_object_with_id ~enc:replies
956
-
|> Json.Codec.Object.opt_member "attachment" (Json.Codec.list Link_or_uri.jsont)
957
-
~enc:attachment
958
-
|> Json.Codec.Object.opt_member "tag" (Json.Codec.list Link_or_uri.jsont) ~enc:tag
1107
+
|> Json.Codec.Object.opt_member "attachment"
1108
+
(Json.Codec.list Link_or_uri.jsont)
1109
+
~enc:attachment
1110
+
|> Json.Codec.Object.opt_member "tag"
1111
+
(Json.Codec.list Link_or_uri.jsont)
1112
+
~enc:tag
959
1113
|> Json.Codec.Object.opt_member "generator" uri_jsont ~enc:generator
960
-
|> Json.Codec.Object.opt_member "icon" (one_or_many Image_ref.jsont) ~enc:icon
961
-
|> Json.Codec.Object.opt_member "image" (one_or_many Image_ref.jsont) ~enc:image
1114
+
|> Json.Codec.Object.opt_member "icon"
1115
+
(one_or_many Image_ref.jsont)
1116
+
~enc:icon
1117
+
|> Json.Codec.Object.opt_member "image"
1118
+
(one_or_many Image_ref.jsont)
1119
+
~enc:image
962
1120
|> Json.Codec.Object.opt_member "startTime" Datetime.jsont ~enc:start_time
963
1121
|> Json.Codec.Object.opt_member "endTime" Datetime.jsont ~enc:end_time
964
1122
|> Json.Codec.Object.opt_member "duration" Json.Codec.string ~enc:duration
965
1123
|> Json.Codec.Object.opt_member "sensitive" Json.Codec.bool ~enc:sensitive
966
1124
|> Json.Codec.Object.opt_member "conversation" uri_jsont ~enc:conversation
967
-
|> Json.Codec.Object.opt_member "audience" (one_or_many Recipient.jsont) ~enc:audience
1125
+
|> Json.Codec.Object.opt_member "audience"
1126
+
(one_or_many Recipient.jsont)
1127
+
~enc:audience
968
1128
|> Json.Codec.Object.opt_member "location" Link_or_uri.jsont ~enc:location
969
1129
|> Json.Codec.Object.opt_member "preview" Link_or_uri.jsont ~enc:preview
970
1130
|> Json.Codec.Object.seal
···
972
1132
973
1133
(** Object reference - can be URI or full Object. *)
974
1134
module Object_ref : sig
975
-
type t =
976
-
| Uri of Uri.t
977
-
| Object of Object.t
1135
+
type t = Uri of Uri.t | Object of Object.t
978
1136
979
1137
val uri : Uri.t -> t
980
1138
val obj : Object.t -> t
981
1139
val jsont : t Json.codec
982
1140
end = struct
983
-
type t =
984
-
| Uri of Uri.t
985
-
| Object of Object.t
1141
+
type t = Uri of Uri.t | Object of Object.t
986
1142
987
1143
let uri u = Uri u
988
1144
let obj o = Object o
989
1145
990
1146
let jsont =
991
-
let dec_string = Json.Codec.map uri_jsont
1147
+
let dec_string =
1148
+
Json.Codec.map uri_jsont
992
1149
~dec:(fun u -> Uri u)
993
-
~enc:(function Uri u -> u | Object _ -> assert false) in
994
-
let dec_object = Json.Codec.map Object.jsont
1150
+
~enc:(function Uri u -> u | Object _ -> assert false)
1151
+
in
1152
+
let dec_object =
1153
+
Json.Codec.map Object.jsont
995
1154
~dec:(fun o -> Object o)
996
-
~enc:(function Object o -> o | Uri _ -> assert false) in
997
-
Json.Codec.any ~kind:"Object reference"
998
-
~dec_string ~dec_object
999
-
~enc:(function
1000
-
| Uri _ -> dec_string
1001
-
| Object _ -> dec_object)
1155
+
~enc:(function Object o -> o | Uri _ -> assert false)
1156
+
in
1157
+
Json.Codec.any ~kind:"Object reference" ~dec_string ~dec_object
1158
+
~enc:(function Uri _ -> dec_string | Object _ -> dec_object)
1002
1159
()
1003
1160
end
1004
1161
···
1128
1285
| _ -> None
1129
1286
1130
1287
let jsont =
1131
-
Json.Codec.enum ~kind:"ActivityType" [
1132
-
"Create", Create;
1133
-
"Update", Update;
1134
-
"Delete", Delete;
1135
-
"Follow", Follow;
1136
-
"Accept", Accept;
1137
-
"Reject", Reject;
1138
-
"Add", Add;
1139
-
"Remove", Remove;
1140
-
"Like", Like;
1141
-
"Announce", Announce;
1142
-
"Undo", Undo;
1143
-
"Block", Block;
1144
-
"Flag", Flag;
1145
-
"Dislike", Dislike;
1146
-
"Ignore", Ignore;
1147
-
"Invite", Invite;
1148
-
"Join", Join;
1149
-
"Leave", Leave;
1150
-
"Listen", Listen;
1151
-
"Move", Move;
1152
-
"Offer", Offer;
1153
-
"Question", Question;
1154
-
"Read", Read;
1155
-
"TentativeAccept", TentativeAccept;
1156
-
"TentativeReject", TentativeReject;
1157
-
"Travel", Travel;
1158
-
"View", View;
1159
-
]
1288
+
Json.Codec.enum ~kind:"ActivityType"
1289
+
[
1290
+
("Create", Create);
1291
+
("Update", Update);
1292
+
("Delete", Delete);
1293
+
("Follow", Follow);
1294
+
("Accept", Accept);
1295
+
("Reject", Reject);
1296
+
("Add", Add);
1297
+
("Remove", Remove);
1298
+
("Like", Like);
1299
+
("Announce", Announce);
1300
+
("Undo", Undo);
1301
+
("Block", Block);
1302
+
("Flag", Flag);
1303
+
("Dislike", Dislike);
1304
+
("Ignore", Ignore);
1305
+
("Invite", Invite);
1306
+
("Join", Join);
1307
+
("Leave", Leave);
1308
+
("Listen", Listen);
1309
+
("Move", Move);
1310
+
("Offer", Offer);
1311
+
("Question", Question);
1312
+
("Read", Read);
1313
+
("TentativeAccept", TentativeAccept);
1314
+
("TentativeReject", TentativeReject);
1315
+
("Travel", Travel);
1316
+
("View", View);
1317
+
]
1160
1318
end
1161
1319
1162
1320
(** {1 Activity} *)
···
1186
1344
?one_of:Object_ref.t list ->
1187
1345
?any_of:Object_ref.t list ->
1188
1346
?closed:Datetime.t ->
1189
-
unit -> t
1347
+
unit ->
1348
+
t
1190
1349
(** Create a new Activity.
1191
1350
1192
1351
The [one_of], [any_of], and [closed] fields are only used for Question
1193
-
activities (polls). Use [one_of] for single-choice polls and [any_of]
1194
-
for multiple-choice polls. *)
1352
+
activities (polls). Use [one_of] for single-choice polls and [any_of] for
1353
+
multiple-choice polls. *)
1195
1354
1196
1355
val context : t -> Context.t option
1197
1356
val id : t -> Uri.t option
···
1214
1373
(** [one_of t] returns single-choice poll options for Question activities. *)
1215
1374
1216
1375
val any_of : t -> Object_ref.t list option
1217
-
(** [any_of t] returns multiple-choice poll options for Question activities. *)
1376
+
(** [any_of t] returns multiple-choice poll options for Question activities.
1377
+
*)
1218
1378
1219
1379
val closed : t -> Datetime.t option
1220
1380
(** [closed t] returns when the poll was closed, for Question activities. *)
···
1245
1405
}
1246
1406
1247
1407
let make ?context ?id ~type_ ~actor ?object_ ?target ?result ?origin
1248
-
?instrument ?to_ ?cc ?bto ?bcc ?published ?updated ?summary
1249
-
?one_of ?any_of ?closed () =
1250
-
{ context; id; type_; actor; object_; target; result; origin;
1251
-
instrument; to_; cc; bto; bcc; published; updated; summary;
1252
-
one_of; any_of; closed }
1408
+
?instrument ?to_ ?cc ?bto ?bcc ?published ?updated ?summary ?one_of
1409
+
?any_of ?closed () =
1410
+
{
1411
+
context;
1412
+
id;
1413
+
type_;
1414
+
actor;
1415
+
object_;
1416
+
target;
1417
+
result;
1418
+
origin;
1419
+
instrument;
1420
+
to_;
1421
+
cc;
1422
+
bto;
1423
+
bcc;
1424
+
published;
1425
+
updated;
1426
+
summary;
1427
+
one_of;
1428
+
any_of;
1429
+
closed;
1430
+
}
1253
1431
1254
1432
let context t = t.context
1255
1433
let id t = t.id
···
1273
1451
1274
1452
let jsont =
1275
1453
Json.Codec.Object.map ~kind:"Activity"
1276
-
(fun context id type_ actor object_ target result origin instrument
1277
-
to_ cc bto bcc published updated summary one_of any_of closed ->
1278
-
{ context; id; type_; actor; object_; target; result; origin;
1279
-
instrument; to_; cc; bto; bcc; published; updated; summary;
1280
-
one_of; any_of; closed })
1454
+
(fun
1455
+
context
1456
+
id
1457
+
type_
1458
+
actor
1459
+
object_
1460
+
target
1461
+
result
1462
+
origin
1463
+
instrument
1464
+
to_
1465
+
cc
1466
+
bto
1467
+
bcc
1468
+
published
1469
+
updated
1470
+
summary
1471
+
one_of
1472
+
any_of
1473
+
closed
1474
+
->
1475
+
{
1476
+
context;
1477
+
id;
1478
+
type_;
1479
+
actor;
1480
+
object_;
1481
+
target;
1482
+
result;
1483
+
origin;
1484
+
instrument;
1485
+
to_;
1486
+
cc;
1487
+
bto;
1488
+
bcc;
1489
+
published;
1490
+
updated;
1491
+
summary;
1492
+
one_of;
1493
+
any_of;
1494
+
closed;
1495
+
})
1281
1496
|> Json.Codec.Object.opt_member "@context" Context.jsont ~enc:context
1282
1497
|> Json.Codec.Object.opt_member "id" uri_jsont ~enc:id
1283
1498
|> Json.Codec.Object.member "type" Activity_type.jsont ~enc:type_
···
1286
1501
|> Json.Codec.Object.opt_member "target" Object_ref.jsont ~enc:target
1287
1502
|> Json.Codec.Object.opt_member "result" Object_ref.jsont ~enc:result
1288
1503
|> Json.Codec.Object.opt_member "origin" Object_ref.jsont ~enc:origin
1289
-
|> Json.Codec.Object.opt_member "instrument" Object_ref.jsont ~enc:instrument
1290
-
|> Json.Codec.Object.opt_member "to" (Json.Codec.list Recipient.jsont) ~enc:to_
1291
-
|> Json.Codec.Object.opt_member "cc" (Json.Codec.list Recipient.jsont) ~enc:cc
1292
-
|> Json.Codec.Object.opt_member "bto" (Json.Codec.list Recipient.jsont) ~enc:bto
1293
-
|> Json.Codec.Object.opt_member "bcc" (Json.Codec.list Recipient.jsont) ~enc:bcc
1504
+
|> Json.Codec.Object.opt_member "instrument" Object_ref.jsont
1505
+
~enc:instrument
1506
+
|> Json.Codec.Object.opt_member "to"
1507
+
(Json.Codec.list Recipient.jsont)
1508
+
~enc:to_
1509
+
|> Json.Codec.Object.opt_member "cc"
1510
+
(Json.Codec.list Recipient.jsont)
1511
+
~enc:cc
1512
+
|> Json.Codec.Object.opt_member "bto"
1513
+
(Json.Codec.list Recipient.jsont)
1514
+
~enc:bto
1515
+
|> Json.Codec.Object.opt_member "bcc"
1516
+
(Json.Codec.list Recipient.jsont)
1517
+
~enc:bcc
1294
1518
|> Json.Codec.Object.opt_member "published" Datetime.jsont ~enc:published
1295
1519
|> Json.Codec.Object.opt_member "updated" Datetime.jsont ~enc:updated
1296
1520
|> Json.Codec.Object.opt_member "summary" Json.Codec.string ~enc:summary
1297
-
|> Json.Codec.Object.opt_member "oneOf" (Json.Codec.list Object_ref.jsont) ~enc:one_of
1298
-
|> Json.Codec.Object.opt_member "anyOf" (Json.Codec.list Object_ref.jsont) ~enc:any_of
1521
+
|> Json.Codec.Object.opt_member "oneOf"
1522
+
(Json.Codec.list Object_ref.jsont)
1523
+
~enc:one_of
1524
+
|> Json.Codec.Object.opt_member "anyOf"
1525
+
(Json.Codec.list Object_ref.jsont)
1526
+
~enc:any_of
1299
1527
|> Json.Codec.Object.opt_member "closed" Datetime.jsont ~enc:closed
1300
1528
|> Json.Codec.Object.seal
1301
1529
end
1302
1530
1303
1531
(** Activity reference - can be URI or full Activity. *)
1304
1532
module Activity_ref : sig
1305
-
type t =
1306
-
| Uri of Uri.t
1307
-
| Activity of Activity.t
1533
+
type t = Uri of Uri.t | Activity of Activity.t
1308
1534
1309
1535
val uri : Uri.t -> t
1310
1536
val activity : Activity.t -> t
1311
1537
val jsont : t Json.codec
1312
1538
end = struct
1313
-
type t =
1314
-
| Uri of Uri.t
1315
-
| Activity of Activity.t
1539
+
type t = Uri of Uri.t | Activity of Activity.t
1316
1540
1317
1541
let uri u = Uri u
1318
1542
let activity a = Activity a
1319
1543
1320
1544
let jsont =
1321
-
let dec_string = Json.Codec.map uri_jsont
1545
+
let dec_string =
1546
+
Json.Codec.map uri_jsont
1322
1547
~dec:(fun u -> Uri u)
1323
-
~enc:(function Uri u -> u | Activity _ -> assert false) in
1324
-
let dec_object = Json.Codec.map Activity.jsont
1548
+
~enc:(function Uri u -> u | Activity _ -> assert false)
1549
+
in
1550
+
let dec_object =
1551
+
Json.Codec.map Activity.jsont
1325
1552
~dec:(fun a -> Activity a)
1326
-
~enc:(function Activity a -> a | Uri _ -> assert false) in
1327
-
Json.Codec.any ~kind:"Activity reference"
1328
-
~dec_string ~dec_object
1329
-
~enc:(function
1330
-
| Uri _ -> dec_string
1331
-
| Activity _ -> dec_object)
1553
+
~enc:(function Activity a -> a | Uri _ -> assert false)
1554
+
in
1555
+
Json.Codec.any ~kind:"Activity reference" ~dec_string ~dec_object
1556
+
~enc:(function Uri _ -> dec_string | Activity _ -> dec_object)
1332
1557
()
1333
1558
end
1334
1559
···
1348
1573
?last:Uri.t ->
1349
1574
?items:'a list ->
1350
1575
ordered:bool ->
1351
-
unit -> 'a t
1576
+
unit ->
1577
+
'a t
1352
1578
1353
1579
val context : 'a t -> Context.t option
1354
1580
val id : 'a t -> Uri.t option
···
1358
1584
val last : 'a t -> Uri.t option
1359
1585
val items : 'a t -> 'a list option
1360
1586
val ordered : 'a t -> bool
1361
-
1362
1587
val jsont : 'a Json.codec -> 'a t Json.codec
1363
1588
end = struct
1364
1589
type 'a t = {
···
1386
1611
1387
1612
let jsont item_jsont =
1388
1613
let type_jsont =
1389
-
Json.Codec.enum ~kind:"CollectionType" [
1390
-
"Collection", false;
1391
-
"OrderedCollection", true;
1392
-
]
1614
+
Json.Codec.enum ~kind:"CollectionType"
1615
+
[ ("Collection", false); ("OrderedCollection", true) ]
1393
1616
in
1394
1617
let list_jsont = Json.Codec.list item_jsont in
1395
1618
Json.Codec.Object.map ~kind:"Collection"
1396
-
(fun context id ordered total_items current first last items ordered_items ->
1397
-
let items = match items, ordered_items with
1398
-
| Some i, _ -> Some i
1399
-
| None, Some i -> Some i
1400
-
| None, None -> None
1401
-
in
1402
-
{ context; id; total_items; current; first; last; items; ordered })
1619
+
(fun
1620
+
context id ordered total_items current first last items ordered_items ->
1621
+
let items =
1622
+
match (items, ordered_items) with
1623
+
| Some i, _ -> Some i
1624
+
| None, Some i -> Some i
1625
+
| None, None -> None
1626
+
in
1627
+
{ context; id; total_items; current; first; last; items; ordered })
1403
1628
|> Json.Codec.Object.opt_member "@context" Context.jsont ~enc:context
1404
1629
|> Json.Codec.Object.opt_member "id" uri_jsont ~enc:id
1405
1630
|> Json.Codec.Object.member "type" type_jsont ~enc:ordered
···
1407
1632
|> Json.Codec.Object.opt_member "current" uri_jsont ~enc:current
1408
1633
|> Json.Codec.Object.opt_member "first" uri_jsont ~enc:first
1409
1634
|> Json.Codec.Object.opt_member "last" uri_jsont ~enc:last
1410
-
|> Json.Codec.Object.opt_member "items" list_jsont
1411
-
~enc:(fun t -> if t.ordered then None else t.items)
1412
-
|> Json.Codec.Object.opt_member "orderedItems" list_jsont
1413
-
~enc:(fun t -> if t.ordered then t.items else None)
1635
+
|> Json.Codec.Object.opt_member "items" list_jsont ~enc:(fun t ->
1636
+
if t.ordered then None else t.items)
1637
+
|> Json.Codec.Object.opt_member "orderedItems" list_jsont ~enc:(fun t ->
1638
+
if t.ordered then t.items else None)
1414
1639
|> Json.Codec.Object.seal
1415
1640
end
1416
1641
1417
1642
(** {1 Collection Page} *)
1418
1643
1419
1644
(** Collection page objects.
1420
-
@see <https://www.w3.org/TR/activitystreams-vocabulary/#dfn-collectionpage> *)
1645
+
@see <https://www.w3.org/TR/activitystreams-vocabulary/#dfn-collectionpage>
1646
+
*)
1421
1647
module Collection_page : sig
1422
1648
type 'a t
1423
1649
···
1433
1659
?part_of:Uri.t ->
1434
1660
?items:'a list ->
1435
1661
ordered:bool ->
1436
-
unit -> 'a t
1662
+
unit ->
1663
+
'a t
1437
1664
1438
1665
val context : 'a t -> Context.t option
1439
1666
val id : 'a t -> Uri.t option
···
1446
1673
val part_of : 'a t -> Uri.t option
1447
1674
val items : 'a t -> 'a list option
1448
1675
val ordered : 'a t -> bool
1449
-
1450
1676
val jsont : 'a Json.codec -> 'a t Json.codec
1451
1677
end = struct
1452
1678
type 'a t = {
···
1463
1689
ordered : bool;
1464
1690
}
1465
1691
1466
-
let make ?context ?id ?total_items ?current ?first ?last ?prev ?next
1467
-
?part_of ?items ~ordered () =
1468
-
{ context; id; total_items; current; first; last; prev; next;
1469
-
part_of; items; ordered }
1692
+
let make ?context ?id ?total_items ?current ?first ?last ?prev ?next ?part_of
1693
+
?items ~ordered () =
1694
+
{
1695
+
context;
1696
+
id;
1697
+
total_items;
1698
+
current;
1699
+
first;
1700
+
last;
1701
+
prev;
1702
+
next;
1703
+
part_of;
1704
+
items;
1705
+
ordered;
1706
+
}
1470
1707
1471
1708
let context t = t.context
1472
1709
let id t = t.id
···
1482
1719
1483
1720
let jsont item_jsont =
1484
1721
let type_jsont =
1485
-
Json.Codec.enum ~kind:"CollectionPageType" [
1486
-
"CollectionPage", false;
1487
-
"OrderedCollectionPage", true;
1488
-
]
1722
+
Json.Codec.enum ~kind:"CollectionPageType"
1723
+
[ ("CollectionPage", false); ("OrderedCollectionPage", true) ]
1489
1724
in
1490
1725
let list_jsont = Json.Codec.list item_jsont in
1491
1726
Json.Codec.Object.map ~kind:"CollectionPage"
1492
-
(fun context id ordered total_items current first last prev next
1493
-
part_of items ordered_items ->
1494
-
let items = match items, ordered_items with
1727
+
(fun
1728
+
context
1729
+
id
1730
+
ordered
1731
+
total_items
1732
+
current
1733
+
first
1734
+
last
1735
+
prev
1736
+
next
1737
+
part_of
1738
+
items
1739
+
ordered_items
1740
+
->
1741
+
let items =
1742
+
match (items, ordered_items) with
1495
1743
| Some i, _ -> Some i
1496
1744
| None, Some i -> Some i
1497
1745
| None, None -> None
1498
1746
in
1499
-
{ context; id; total_items; current; first; last; prev; next;
1500
-
part_of; items; ordered })
1747
+
{
1748
+
context;
1749
+
id;
1750
+
total_items;
1751
+
current;
1752
+
first;
1753
+
last;
1754
+
prev;
1755
+
next;
1756
+
part_of;
1757
+
items;
1758
+
ordered;
1759
+
})
1501
1760
|> Json.Codec.Object.opt_member "@context" Context.jsont ~enc:context
1502
1761
|> Json.Codec.Object.opt_member "id" uri_jsont ~enc:id
1503
1762
|> Json.Codec.Object.member "type" type_jsont ~enc:ordered
···
1508
1767
|> Json.Codec.Object.opt_member "prev" uri_jsont ~enc:prev
1509
1768
|> Json.Codec.Object.opt_member "next" uri_jsont ~enc:next
1510
1769
|> Json.Codec.Object.opt_member "partOf" uri_jsont ~enc:part_of
1511
-
|> Json.Codec.Object.opt_member "items" list_jsont
1512
-
~enc:(fun t -> if t.ordered then None else t.items)
1513
-
|> Json.Codec.Object.opt_member "orderedItems" list_jsont
1514
-
~enc:(fun t -> if t.ordered then t.items else None)
1770
+
|> Json.Codec.Object.opt_member "items" list_jsont ~enc:(fun t ->
1771
+
if t.ordered then None else t.items)
1772
+
|> Json.Codec.Object.opt_member "orderedItems" list_jsont ~enc:(fun t ->
1773
+
if t.ordered then t.items else None)
1515
1774
|> Json.Codec.Object.seal
1516
1775
end
1517
1776
···
1520
1779
(** Activity collection. *)
1521
1780
module Activity_collection : sig
1522
1781
type t = Activity.t Collection.t
1782
+
1523
1783
val jsont : t Json.codec
1524
1784
end = struct
1525
1785
type t = Activity.t Collection.t
1786
+
1526
1787
let jsont = Collection.jsont Activity.jsont
1527
1788
end
1528
1789
1529
1790
(** Object collection. *)
1530
1791
module Object_collection : sig
1531
1792
type t = Object.t Collection.t
1793
+
1532
1794
val jsont : t Json.codec
1533
1795
end = struct
1534
1796
type t = Object.t Collection.t
1797
+
1535
1798
let jsont = Collection.jsont Object.jsont
1536
1799
end
1537
1800
1538
1801
(** Activity collection page. *)
1539
1802
module Activity_collection_page : sig
1540
1803
type t = Activity.t Collection_page.t
1804
+
1541
1805
val jsont : t Json.codec
1542
1806
end = struct
1543
1807
type t = Activity.t Collection_page.t
1808
+
1544
1809
let jsont = Collection_page.jsont Activity.jsont
1545
1810
end
1546
1811
1547
1812
(** Object collection page. *)
1548
1813
module Object_collection_page : sig
1549
1814
type t = Object.t Collection_page.t
1815
+
1550
1816
val jsont : t Json.codec
1551
1817
end = struct
1552
1818
type t = Object.t Collection_page.t
1819
+
1553
1820
let jsont = Collection_page.jsont Object.jsont
1554
1821
end
1555
1822
···
1567
1834
?type_:string ->
1568
1835
?href:Uri.t ->
1569
1836
?template:string ->
1570
-
unit -> t
1837
+
unit ->
1838
+
t
1571
1839
1572
1840
val rel : t -> string
1573
1841
val type_ : t -> string option
1574
1842
val href : t -> Uri.t option
1575
1843
val template : t -> string option
1576
-
1577
1844
val jsont : t Json.codec
1578
1845
end
1579
1846
1580
-
(** The Webfinger JRD response. *)
1581
1847
type t
1848
+
(** The Webfinger JRD response. *)
1582
1849
1583
1850
val make :
1584
1851
subject:string ->
1585
1852
?aliases:string list ->
1586
1853
?properties:(string * string) list ->
1587
1854
?links:Jrd_link.t list ->
1588
-
unit -> t
1855
+
unit ->
1856
+
t
1589
1857
1590
1858
val subject : t -> string
1591
1859
val aliases : t -> string list option
1592
1860
val properties : t -> (string * string) list option
1593
1861
val links : t -> Jrd_link.t list option
1594
-
1595
1862
val jsont : t Json.codec
1596
1863
end = struct
1597
1864
module Jrd_link = struct
···
1602
1869
template : string option;
1603
1870
}
1604
1871
1605
-
let make ~rel ?type_ ?href ?template () =
1606
-
{ rel; type_; href; template }
1607
-
1872
+
let make ~rel ?type_ ?href ?template () = { rel; type_; href; template }
1608
1873
let rel t = t.rel
1609
1874
let type_ t = t.type_
1610
1875
let href t = t.href
1611
1876
let template t = t.template
1612
1877
1613
1878
let jsont =
1614
-
Json.Codec.Object.map ~kind:"JrdLink"
1615
-
(fun rel type_ href template -> { rel; type_; href; template })
1879
+
Json.Codec.Object.map ~kind:"JrdLink" (fun rel type_ href template ->
1880
+
{ rel; type_; href; template })
1616
1881
|> Json.Codec.Object.member "rel" Json.Codec.string ~enc:rel
1617
1882
|> Json.Codec.Object.opt_member "type" Json.Codec.string ~enc:type_
1618
1883
|> Json.Codec.Object.opt_member "href" uri_jsont ~enc:href
···
1635
1900
let properties t = t.properties
1636
1901
let links t = t.links
1637
1902
1638
-
module String_map = Map.Make(String)
1903
+
module String_map = Map.Make (String)
1639
1904
1640
1905
let properties_jsont =
1641
1906
Json.Codec.Object.as_string_map Json.Codec.string
1642
1907
|> Json.Codec.map
1643
-
~dec:(fun m -> String_map.bindings m)
1644
-
~enc:(fun l -> List.fold_left (fun m (k, v) ->
1645
-
String_map.add k v m) String_map.empty l)
1908
+
~dec:(fun m -> String_map.bindings m)
1909
+
~enc:(fun l ->
1910
+
List.fold_left
1911
+
(fun m (k, v) -> String_map.add k v m)
1912
+
String_map.empty l)
1646
1913
1647
1914
let jsont =
1648
1915
Json.Codec.Object.map ~kind:"Webfinger"
1649
1916
(fun subject aliases properties links ->
1650
-
{ subject; aliases; properties; links })
1917
+
{ subject; aliases; properties; links })
1651
1918
|> Json.Codec.Object.member "subject" Json.Codec.string ~enc:subject
1652
-
|> Json.Codec.Object.opt_member "aliases" (Json.Codec.list Json.Codec.string) ~enc:aliases
1653
-
|> Json.Codec.Object.opt_member "properties" properties_jsont ~enc:properties
1654
-
|> Json.Codec.Object.opt_member "links" (Json.Codec.list Jrd_link.jsont) ~enc:links
1919
+
|> Json.Codec.Object.opt_member "aliases"
1920
+
(Json.Codec.list Json.Codec.string)
1921
+
~enc:aliases
1922
+
|> Json.Codec.Object.opt_member "properties" properties_jsont
1923
+
~enc:properties
1924
+
|> Json.Codec.Object.opt_member "links"
1925
+
(Json.Codec.list Jrd_link.jsont)
1926
+
~enc:links
1655
1927
|> Json.Codec.Object.seal
1656
1928
end
1657
1929
···
1669
1941
version:string ->
1670
1942
?repository:Uri.t ->
1671
1943
?homepage:Uri.t ->
1672
-
unit -> t
1944
+
unit ->
1945
+
t
1673
1946
1674
1947
val name : t -> string
1675
1948
val version : t -> string
1676
1949
val repository : t -> Uri.t option
1677
1950
val homepage : t -> Uri.t option
1678
-
1679
1951
val jsont : t Json.codec
1680
1952
end
1681
1953
···
1689
1961
?users_active_month:int ->
1690
1962
?local_posts:int ->
1691
1963
?local_comments:int ->
1692
-
unit -> t
1964
+
unit ->
1965
+
t
1693
1966
1694
1967
val users_total : t -> int option
1695
1968
val users_active_half_year : t -> int option
1696
1969
val users_active_month : t -> int option
1697
1970
val local_posts : t -> int option
1698
1971
val local_comments : t -> int option
1699
-
1700
1972
val jsont : t Json.codec
1701
1973
end
1702
1974
···
1709
1981
usage:Usage.t ->
1710
1982
open_registrations:bool ->
1711
1983
?metadata:Json.t ->
1712
-
unit -> t
1984
+
unit ->
1985
+
t
1713
1986
1714
1987
val version : t -> string
1715
1988
val software : t -> Software.t
···
1717
1990
val usage : t -> Usage.t
1718
1991
val open_registrations : t -> bool
1719
1992
val metadata : t -> Json.t option
1720
-
1721
1993
val jsont : t Json.codec
1722
1994
end = struct
1723
1995
module Software = struct
···
1739
2011
let jsont =
1740
2012
Json.Codec.Object.map ~kind:"Software"
1741
2013
(fun name version repository homepage ->
1742
-
{ name; version; repository; homepage })
2014
+
{ name; version; repository; homepage })
1743
2015
|> Json.Codec.Object.member "name" Json.Codec.string ~enc:name
1744
2016
|> Json.Codec.Object.member "version" Json.Codec.string ~enc:version
1745
2017
|> Json.Codec.Object.opt_member "repository" uri_jsont ~enc:repository
···
1758
2030
1759
2031
let make ?users_total ?users_active_half_year ?users_active_month
1760
2032
?local_posts ?local_comments () =
1761
-
{ users_total; users_active_half_year; users_active_month;
1762
-
local_posts; local_comments }
2033
+
{
2034
+
users_total;
2035
+
users_active_half_year;
2036
+
users_active_month;
2037
+
local_posts;
2038
+
local_comments;
2039
+
}
1763
2040
1764
2041
let users_total t = t.users_total
1765
2042
let users_active_half_year t = t.users_active_half_year
···
1770
2047
let users_jsont =
1771
2048
Json.Codec.Object.map ~kind:"Users"
1772
2049
(fun total active_half_year active_month ->
1773
-
(total, active_half_year, active_month))
2050
+
(total, active_half_year, active_month))
1774
2051
|> Json.Codec.Object.opt_member "total" Json.Codec.int
1775
-
~enc:(fun (t, _, _) -> t)
2052
+
~enc:(fun (t, _, _) -> t)
1776
2053
|> Json.Codec.Object.opt_member "activeHalfyear" Json.Codec.int
1777
-
~enc:(fun (_, h, _) -> h)
2054
+
~enc:(fun (_, h, _) -> h)
1778
2055
|> Json.Codec.Object.opt_member "activeMonth" Json.Codec.int
1779
-
~enc:(fun (_, _, m) -> m)
2056
+
~enc:(fun (_, _, m) -> m)
1780
2057
|> Json.Codec.Object.seal
1781
2058
1782
2059
let jsont =
1783
2060
Json.Codec.Object.map ~kind:"Usage"
1784
-
(fun (users_total, users_active_half_year, users_active_month)
1785
-
local_posts local_comments ->
1786
-
{ users_total; users_active_half_year; users_active_month;
1787
-
local_posts; local_comments })
2061
+
(fun
2062
+
(users_total, users_active_half_year, users_active_month)
2063
+
local_posts
2064
+
local_comments
2065
+
->
2066
+
{
2067
+
users_total;
2068
+
users_active_half_year;
2069
+
users_active_month;
2070
+
local_posts;
2071
+
local_comments;
2072
+
})
1788
2073
|> Json.Codec.Object.member "users" users_jsont
1789
-
~dec_absent:(None, None, None)
1790
-
~enc:(fun t -> (t.users_total, t.users_active_half_year,
1791
-
t.users_active_month))
1792
-
|> Json.Codec.Object.opt_member "localPosts" Json.Codec.int ~enc:local_posts
1793
-
|> Json.Codec.Object.opt_member "localComments" Json.Codec.int ~enc:local_comments
2074
+
~dec_absent:(None, None, None) ~enc:(fun t ->
2075
+
(t.users_total, t.users_active_half_year, t.users_active_month))
2076
+
|> Json.Codec.Object.opt_member "localPosts" Json.Codec.int
2077
+
~enc:local_posts
2078
+
|> Json.Codec.Object.opt_member "localComments" Json.Codec.int
2079
+
~enc:local_comments
1794
2080
|> Json.Codec.Object.seal
1795
2081
end
1796
2082
···
1803
2089
metadata : Json.t option;
1804
2090
}
1805
2091
1806
-
let make ~version ~software ~protocols ~usage ~open_registrations
1807
-
?metadata () =
2092
+
let make ~version ~software ~protocols ~usage ~open_registrations ?metadata ()
2093
+
=
1808
2094
{ version; software; protocols; usage; open_registrations; metadata }
1809
2095
1810
2096
let version t = t.version
···
1817
2103
let jsont =
1818
2104
Json.Codec.Object.map ~kind:"Nodeinfo"
1819
2105
(fun version software protocols usage open_registrations metadata ->
1820
-
{ version; software; protocols; usage; open_registrations; metadata })
2106
+
{ version; software; protocols; usage; open_registrations; metadata })
1821
2107
|> Json.Codec.Object.member "version" Json.Codec.string ~enc:version
1822
2108
|> Json.Codec.Object.member "software" Software.jsont ~enc:software
1823
-
|> Json.Codec.Object.member "protocols" (Json.Codec.list Json.Codec.string) ~enc:protocols
2109
+
|> Json.Codec.Object.member "protocols"
2110
+
(Json.Codec.list Json.Codec.string)
2111
+
~enc:protocols
1824
2112
|> Json.Codec.Object.member "usage" Usage.jsont ~enc:usage
1825
-
|> Json.Codec.Object.member "openRegistrations" Json.Codec.bool ~enc:open_registrations
2113
+
|> Json.Codec.Object.member "openRegistrations" Json.Codec.bool
2114
+
~enc:open_registrations
1826
2115
|> Json.Codec.Object.opt_member "metadata" Json.Codec.Value.t ~enc:metadata
1827
2116
|> Json.Codec.Object.seal
1828
2117
end
+51
-57
lib/proto/apubt_proto.mli
+51
-57
lib/proto/apubt_proto.mli
···
21
21
22
22
@see <https://www.w3.org/TR/activitypub/> ActivityPub specification
23
23
@see <https://www.w3.org/TR/activitystreams-core/> ActivityStreams Core
24
-
@see <https://www.w3.org/TR/activitystreams-vocabulary/> ActivityStreams Vocabulary *)
24
+
@see <https://www.w3.org/TR/activitystreams-vocabulary/>
25
+
ActivityStreams Vocabulary *)
25
26
26
27
(** {1 Common Types} *)
27
28
···
68
69
?width:int ->
69
70
?preview:Uri.t ->
70
71
href:Uri.t ->
71
-
unit -> t
72
+
unit ->
73
+
t
72
74
(** Create a new Link. *)
73
75
74
76
val href : t -> Uri.t
···
85
87
86
88
(** Reference that can be either a URI string or a Link object. *)
87
89
module Link_or_uri : sig
88
-
type t =
89
-
| Uri of Uri.t
90
-
| Link of Link.t
90
+
type t = Uri of Uri.t | Link of Link.t
91
91
92
92
val uri : Uri.t -> t
93
93
val link : Link.t -> t
···
108
108
?width:int ->
109
109
?height:int ->
110
110
url:Link_or_uri.t ->
111
-
unit -> t
111
+
unit ->
112
+
t
112
113
113
114
val id : t -> Uri.t option
114
115
val url : t -> Link_or_uri.t
···
116
117
val media_type : t -> string option
117
118
val width : t -> int option
118
119
val height : t -> int option
119
-
120
120
val jsont : t Json.codec
121
121
end
122
122
123
123
(** Image reference - can be URI, Link, or full Image object. *)
124
124
module Image_ref : sig
125
-
type t =
126
-
| Uri of Uri.t
127
-
| Link of Link.t
128
-
| Image of Image.t
125
+
type t = Uri of Uri.t | Link of Link.t | Image of Image.t
129
126
130
127
val uri : Uri.t -> t
131
128
val link : Link.t -> t
···
166
163
?provide_client_key:Uri.t ->
167
164
?sign_client_key:Uri.t ->
168
165
?shared_inbox:Uri.t ->
169
-
unit -> t
166
+
unit ->
167
+
t
170
168
171
169
val proxy_url : t -> Uri.t option
172
170
val oauth_authorization_endpoint : t -> Uri.t option
···
174
172
val provide_client_key : t -> Uri.t option
175
173
val sign_client_key : t -> Uri.t option
176
174
val shared_inbox : t -> Uri.t option
177
-
178
175
val jsont : t Json.codec
179
176
end
180
177
···
184
181
module Public_key : sig
185
182
type t
186
183
187
-
val make :
188
-
id:Uri.t ->
189
-
owner:Uri.t ->
190
-
public_key_pem:string ->
191
-
unit -> t
192
-
184
+
val make : id:Uri.t -> owner:Uri.t -> public_key_pem:string -> unit -> t
193
185
val id : t -> Uri.t
194
186
val owner : t -> Uri.t
195
187
val public_key_pem : t -> string
196
-
197
188
val jsont : t Json.codec
198
189
end
199
190
···
201
192
202
193
(** Actor types enumeration. *)
203
194
module Actor_type : sig
204
-
type t =
205
-
| Person
206
-
| Service
207
-
| Organization
208
-
| Group
209
-
| Application
195
+
type t = Person | Service | Organization | Group | Application
210
196
211
197
val to_string : t -> string
212
198
val of_string : string -> t option
···
245
231
?moved_to:Uri.t ->
246
232
?featured:Uri.t ->
247
233
?featured_tags:Uri.t ->
248
-
unit -> t
234
+
unit ->
235
+
t
249
236
(** Create a new Actor. *)
250
237
251
238
val context : t -> Context.t option
···
279
266
280
267
(** Actor reference - can be URI or full Actor object. *)
281
268
module Actor_ref : sig
282
-
type t =
283
-
| Uri of Uri.t
284
-
| Actor of Actor.t
269
+
type t = Uri of Uri.t | Actor of Actor.t
285
270
286
271
val uri : Uri.t -> t
287
272
val actor : Actor.t -> t
···
351
336
?audience:Recipient.t list ->
352
337
?location:Link_or_uri.t ->
353
338
?preview:Link_or_uri.t ->
354
-
unit -> t
339
+
unit ->
340
+
t
355
341
(** Create a new Object. *)
356
342
357
343
val context : t -> Context.t option
···
385
371
val audience : t -> Recipient.t list option
386
372
387
373
val location : t -> Link_or_uri.t option
388
-
(** [location t] returns the physical or logical location associated with the object. *)
374
+
(** [location t] returns the physical or logical location associated with the
375
+
object. *)
389
376
390
377
val preview : t -> Link_or_uri.t option
391
-
(** [preview t] returns a preview of the object, typically a smaller version. *)
378
+
(** [preview t] returns a preview of the object, typically a smaller version.
379
+
*)
392
380
393
381
val jsont : t Json.codec
394
382
(** JSON type for Objects. *)
···
396
384
397
385
(** Object reference - can be URI or full Object. *)
398
386
module Object_ref : sig
399
-
type t =
400
-
| Uri of Uri.t
401
-
| Object of Object.t
387
+
type t = Uri of Uri.t | Object of Object.t
402
388
403
389
val uri : Uri.t -> t
404
390
val obj : Object.t -> t
···
470
456
?one_of:Object_ref.t list ->
471
457
?any_of:Object_ref.t list ->
472
458
?closed:Datetime.t ->
473
-
unit -> t
459
+
unit ->
460
+
t
474
461
(** Create a new Activity.
475
462
476
463
The [one_of], [any_of], and [closed] fields are only used for Question
477
-
activities (polls). Use [one_of] for single-choice polls and [any_of]
478
-
for multiple-choice polls. *)
464
+
activities (polls). Use [one_of] for single-choice polls and [any_of] for
465
+
multiple-choice polls. *)
479
466
480
467
val context : t -> Context.t option
481
468
val id : t -> Uri.t option
···
498
485
(** [one_of t] returns single-choice poll options for Question activities. *)
499
486
500
487
val any_of : t -> Object_ref.t list option
501
-
(** [any_of t] returns multiple-choice poll options for Question activities. *)
488
+
(** [any_of t] returns multiple-choice poll options for Question activities.
489
+
*)
502
490
503
491
val closed : t -> Datetime.t option
504
492
(** [closed t] returns when the poll was closed, for Question activities. *)
···
509
497
510
498
(** Activity reference - can be URI or full Activity. *)
511
499
module Activity_ref : sig
512
-
type t =
513
-
| Uri of Uri.t
514
-
| Activity of Activity.t
500
+
type t = Uri of Uri.t | Activity of Activity.t
515
501
516
502
val uri : Uri.t -> t
517
503
val activity : Activity.t -> t
···
534
520
?last:Uri.t ->
535
521
?items:'a list ->
536
522
ordered:bool ->
537
-
unit -> 'a t
523
+
unit ->
524
+
'a t
538
525
(** Create a new Collection. Use [~ordered:true] for OrderedCollection. *)
539
526
540
527
val context : 'a t -> Context.t option
···
553
540
(** {1 Collection Page} *)
554
541
555
542
(** Collection page objects.
556
-
@see <https://www.w3.org/TR/activitystreams-vocabulary/#dfn-collectionpage> *)
543
+
@see <https://www.w3.org/TR/activitystreams-vocabulary/#dfn-collectionpage>
544
+
*)
557
545
module Collection_page : sig
558
546
type 'a t
559
547
···
569
557
?part_of:Uri.t ->
570
558
?items:'a list ->
571
559
ordered:bool ->
572
-
unit -> 'a t
573
-
(** Create a new CollectionPage. Use [~ordered:true] for OrderedCollectionPage. *)
560
+
unit ->
561
+
'a t
562
+
(** Create a new CollectionPage. Use [~ordered:true] for
563
+
OrderedCollectionPage. *)
574
564
575
565
val context : 'a t -> Context.t option
576
566
val id : 'a t -> Uri.t option
···
593
583
(** Activity collection. *)
594
584
module Activity_collection : sig
595
585
type t = Activity.t Collection.t
586
+
596
587
val jsont : t Json.codec
597
588
end
598
589
599
590
(** Object collection. *)
600
591
module Object_collection : sig
601
592
type t = Object.t Collection.t
593
+
602
594
val jsont : t Json.codec
603
595
end
604
596
605
597
(** Activity collection page. *)
606
598
module Activity_collection_page : sig
607
599
type t = Activity.t Collection_page.t
600
+
608
601
val jsont : t Json.codec
609
602
end
610
603
611
604
(** Object collection page. *)
612
605
module Object_collection_page : sig
613
606
type t = Object.t Collection_page.t
607
+
614
608
val jsont : t Json.codec
615
609
end
616
610
···
628
622
?type_:string ->
629
623
?href:Uri.t ->
630
624
?template:string ->
631
-
unit -> t
625
+
unit ->
626
+
t
632
627
633
628
val rel : t -> string
634
629
val type_ : t -> string option
635
630
val href : t -> Uri.t option
636
631
val template : t -> string option
637
-
638
632
val jsont : t Json.codec
639
633
end
640
634
···
645
639
?aliases:string list ->
646
640
?properties:(string * string) list ->
647
641
?links:Jrd_link.t list ->
648
-
unit -> t
642
+
unit ->
643
+
t
649
644
650
645
val subject : t -> string
651
646
val aliases : t -> string list option
652
647
val properties : t -> (string * string) list option
653
648
val links : t -> Jrd_link.t list option
654
-
655
649
val jsont : t Json.codec
656
650
end
657
651
···
669
663
version:string ->
670
664
?repository:Uri.t ->
671
665
?homepage:Uri.t ->
672
-
unit -> t
666
+
unit ->
667
+
t
673
668
674
669
val name : t -> string
675
670
val version : t -> string
676
671
val repository : t -> Uri.t option
677
672
val homepage : t -> Uri.t option
678
-
679
673
val jsont : t Json.codec
680
674
end
681
675
···
689
683
?users_active_month:int ->
690
684
?local_posts:int ->
691
685
?local_comments:int ->
692
-
unit -> t
686
+
unit ->
687
+
t
693
688
694
689
val users_total : t -> int option
695
690
val users_active_half_year : t -> int option
696
691
val users_active_month : t -> int option
697
692
val local_posts : t -> int option
698
693
val local_comments : t -> int option
699
-
700
694
val jsont : t Json.codec
701
695
end
702
696
···
709
703
usage:Usage.t ->
710
704
open_registrations:bool ->
711
705
?metadata:Json.t ->
712
-
unit -> t
706
+
unit ->
707
+
t
713
708
714
709
val version : t -> string
715
710
val software : t -> Software.t
···
717
712
val usage : t -> Usage.t
718
713
val open_registrations : t -> bool
719
714
val metadata : t -> Json.t option
720
-
721
715
val jsont : t Json.codec
722
716
end